Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ocamltest: refactoring and implementation of hooks

master
Sébastien Hinderer 2017-11-03 18:52:11 +01:00
parent c6f3a00b31
commit f0b9b8e9c4
40 changed files with 1979 additions and 1363 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
ocamltest/.depend
View File

@ -1,64 +1,88 @@
run_unix.$(O): run_unix.c run.h run_common.h
run_stubs.$(O): run_stubs.c run.h ../byterun/caml/mlvalues.h \
run_unix.$(O): run_unix.c run.h ../byterun/caml/misc.h \
../byterun/caml/config.h ../byterun/caml/m.h ../byterun/caml/s.h \
../byterun/caml/misc.h ../byterun/caml/memory.h ../byterun/caml/gc.h \
../byterun/caml/mlvalues.h ../byterun/caml/major_gc.h \
../byterun/caml/freelist.h ../byterun/caml/minor_gc.h \
../byterun/caml/address_class.h ../byterun/caml/io.h
run_common.h
run_stubs.$(O): run_stubs.c run.h ../byterun/caml/misc.h \
../byterun/caml/config.h ../byterun/caml/m.h ../byterun/caml/s.h \
../byterun/caml/mlvalues.h ../byterun/caml/misc.h \
../byterun/caml/memory.h ../byterun/caml/gc.h ../byterun/caml/mlvalues.h \
../byterun/caml/major_gc.h ../byterun/caml/freelist.h \
../byterun/caml/minor_gc.h ../byterun/caml/address_class.h \
../byterun/caml/io.h ../byterun/caml/osdeps.h ../byterun/caml/memory.h
actions.cmo : environments.cmi actions.cmi
actions.cmx : environments.cmx actions.cmi
actions.cmi : environments.cmi
backends.cmo : backends.cmi
backends.cmx : backends.cmi
backends.cmi :
builtin_actions.cmo : variables.cmi testlib.cmi run_command.cmi \
ocamltest_config.cmi filetype.cmi filecompare.cmi environments.cmi \
builtin_variables.cmi builtin_modifiers.cmi backends.cmi actions.cmi \
actions_helpers.cmo : variables.cmi run_command.cmi ocamltest_stdlib.cmi \
filecompare.cmi environments.cmi builtin_variables.cmi actions.cmi \
actions_helpers.cmi
actions_helpers.cmx : variables.cmx run_command.cmx ocamltest_stdlib.cmx \
filecompare.cmx environments.cmx builtin_variables.cmx actions.cmx \
actions_helpers.cmi
actions_helpers.cmi : variables.cmi environments.cmi actions.cmi
builtin_actions.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
environments.cmi builtin_variables.cmi actions_helpers.cmi actions.cmi \
builtin_actions.cmi
builtin_actions.cmx : variables.cmx testlib.cmx run_command.cmx \
ocamltest_config.cmx filetype.cmx filecompare.cmx environments.cmx \
builtin_variables.cmx builtin_modifiers.cmx backends.cmx actions.cmx \
builtin_actions.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
environments.cmx builtin_variables.cmx actions_helpers.cmx actions.cmx \
builtin_actions.cmi
builtin_actions.cmi : actions.cmi
builtin_modifiers.cmo : environments.cmi builtin_variables.cmi \
builtin_modifiers.cmi
builtin_modifiers.cmx : environments.cmx builtin_variables.cmx \
builtin_modifiers.cmi
builtin_modifiers.cmi : environments.cmi
builtin_tests.cmo : tests.cmi builtin_actions.cmi builtin_tests.cmi
builtin_tests.cmx : tests.cmx builtin_actions.cmx builtin_tests.cmi
builtin_tests.cmi : tests.cmi
builtin_variables.cmo : variables.cmi builtin_variables.cmi
builtin_variables.cmx : variables.cmx builtin_variables.cmi
builtin_variables.cmi : variables.cmi
environments.cmo : variables.cmi environments.cmi
environments.cmx : variables.cmx environments.cmi
environments.cmo : variables.cmi ocamltest_stdlib.cmi environments.cmi
environments.cmx : variables.cmx ocamltest_stdlib.cmx environments.cmi
environments.cmi : variables.cmi
filecompare.cmo : testlib.cmi run_command.cmi filecompare.cmi
filecompare.cmx : testlib.cmx run_command.cmx filecompare.cmi
filecompare.cmo : run_command.cmi ocamltest_stdlib.cmi filecompare.cmi
filecompare.cmx : run_command.cmx ocamltest_stdlib.cmx filecompare.cmi
filecompare.cmi :
filetype.cmo : filetype.cmi
filetype.cmx : filetype.cmi
filetype.cmi :
main.cmo : tsl_semantics.cmi tsl_parser.cmi tsl_lexer.cmi tests.cmi \
testlib.cmi options.cmi ocamltest_config.cmi environments.cmi \
builtin_variables.cmi actions.cmi main.cmi
options.cmi ocamltest_stdlib.cmi environments.cmi builtin_variables.cmi \
actions_helpers.cmi actions.cmi main.cmi
main.cmx : tsl_semantics.cmx tsl_parser.cmx tsl_lexer.cmx tests.cmx \
testlib.cmx options.cmx ocamltest_config.cmx environments.cmx \
builtin_variables.cmx actions.cmx main.cmi
options.cmx ocamltest_stdlib.cmx environments.cmx builtin_variables.cmx \
actions_helpers.cmx actions.cmx main.cmi
main.cmi :
ocaml_actions.cmo : variables.cmi ocamltest_stdlib.cmi ocamltest_config.cmi \
ocaml_variables.cmi ocaml_modifiers.cmi ocaml_backends.cmi filetype.cmi \
filecompare.cmi environments.cmi builtin_variables.cmi \
actions_helpers.cmi actions.cmi ocaml_actions.cmi
ocaml_actions.cmx : variables.cmx ocamltest_stdlib.cmx ocamltest_config.cmx \
ocaml_variables.cmx ocaml_modifiers.cmx ocaml_backends.cmx filetype.cmx \
filecompare.cmx environments.cmx builtin_variables.cmx \
actions_helpers.cmx actions.cmx ocaml_actions.cmi
ocaml_actions.cmi : actions.cmi
ocaml_backends.cmo : ocamltest_stdlib.cmi ocaml_backends.cmi
ocaml_backends.cmx : ocamltest_stdlib.cmx ocaml_backends.cmi
ocaml_backends.cmi : ocamltest_stdlib.cmi
ocaml_modifiers.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
ocaml_variables.cmi environments.cmi builtin_variables.cmi \
ocaml_modifiers.cmi
ocaml_modifiers.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
ocaml_variables.cmx environments.cmx builtin_variables.cmx \
ocaml_modifiers.cmi
ocaml_modifiers.cmi : environments.cmi
ocaml_tests.cmo : tests.cmi ocamltest_config.cmi ocaml_actions.cmi \
builtin_actions.cmi ocaml_tests.cmi
ocaml_tests.cmx : tests.cmx ocamltest_config.cmx ocaml_actions.cmx \
builtin_actions.cmx ocaml_tests.cmi
ocaml_tests.cmi : tests.cmi
ocaml_variables.cmo : variables.cmi ocaml_variables.cmi
ocaml_variables.cmx : variables.cmx ocaml_variables.cmi
ocaml_variables.cmi : variables.cmi
ocamltest_config.cmo : ocamltest_config.cmi
ocamltest_config.cmx : ocamltest_config.cmi
ocamltest_config.cmi :
ocamltest_stdlib.cmo : ocamltest_stdlib.cmi
ocamltest_stdlib.cmx : ocamltest_stdlib.cmi
ocamltest_stdlib.cmi :
options.cmo : tests.cmi actions.cmi options.cmi
options.cmx : tests.cmx actions.cmx options.cmi
options.cmi :
run_command.cmo : testlib.cmi run_command.cmi
run_command.cmx : testlib.cmx run_command.cmi
run_command.cmo : ocamltest_stdlib.cmi run_command.cmi
run_command.cmx : ocamltest_stdlib.cmx run_command.cmi
run_command.cmi :
testlib.cmo : testlib.cmi
testlib.cmx : testlib.cmi
testlib.cmi :
tests.cmo : actions.cmi tests.cmi
tests.cmx : actions.cmx tests.cmi
tests.cmi : environments.cmi actions.cmi
@ -71,10 +95,10 @@ tsl_lexer.cmi : tsl_parser.cmi
tsl_parser.cmo : tsl_ast.cmi tsl_parser.cmi
tsl_parser.cmx : tsl_ast.cmx tsl_parser.cmi
tsl_parser.cmi : tsl_ast.cmi
tsl_semantics.cmo : variables.cmi tsl_ast.cmi tests.cmi testlib.cmi \
environments.cmi actions.cmi tsl_semantics.cmi
tsl_semantics.cmx : variables.cmx tsl_ast.cmx tests.cmx testlib.cmx \
environments.cmx actions.cmx tsl_semantics.cmi
tsl_semantics.cmo : variables.cmi tsl_ast.cmi tests.cmi environments.cmi \
actions.cmi tsl_semantics.cmi
tsl_semantics.cmx : variables.cmx tsl_ast.cmx tests.cmx environments.cmx \
actions.cmx tsl_semantics.cmi
tsl_semantics.cmi : tsl_ast.cmi tests.cmi environments.cmi actions.cmi
variables.cmo : variables.cmi
variables.cmx : variables.cmi

27
ocamltest/Makefile
View File

@ -19,7 +19,8 @@ include ../config/Makefile
ifeq "$(UNIX_OR_WIN32)" "win32"
unix := false
ocamlsrcdir := $(shell echo "$(abspath $(shell pwd)/..)"|cygpath -m -f -)
ocamlsrcdir := $(shell echo "$(abspath $(shell pwd)/..)"|cygpath -w -f - \
| sed 's/\\/\\\\\\\\/g')
else
unix := true
ocamlsrcdir := $(abspath $(shell pwd)/..)
@ -32,27 +33,37 @@ run := run_$(UNIX_OR_WIN32)
# List of source files from which ocamltest is compiled
# (all the different sorts of files are derived from this)
sources := \
# ocamltest has two components: its core and the OCaml "plugin"
# which is actually built into the tool but clearly separated from its core
core := \
$(run).c \
run_stubs.c \
ocamltest_config.mli ocamltest_config.ml.in \
testlib.mli testlib.ml \
ocamltest_stdlib.mli ocamltest_stdlib.ml \
run_command.mli run_command.ml \
filetype.mli filetype.ml \
filecompare.mli filecompare.ml \
backends.mli backends.ml \
variables.mli variables.ml \
environments.mli environments.ml \
builtin_variables.mli builtin_variables.ml \
builtin_modifiers.mli builtin_modifiers.ml \
actions.mli actions.ml \
builtin_actions.mli builtin_actions.ml \
tests.mli tests.ml \
builtin_tests.mli builtin_tests.ml \
tsl_ast.mli tsl_ast.ml \
tsl_parser.mly \
tsl_lexer.mli tsl_lexer.mll \
tsl_semantics.mli tsl_semantics.ml \
builtin_variables.mli builtin_variables.ml \
actions_helpers.mli actions_helpers.ml \
builtin_actions.mli builtin_actions.ml
ocaml_plugin := \
ocaml_backends.mli ocaml_backends.ml \
ocaml_variables.mli ocaml_variables.ml \
ocaml_modifiers.mli ocaml_modifiers.ml \
ocaml_actions.mli ocaml_actions.ml \
ocaml_tests.mli ocaml_tests.ml
sources := $(core) $(ocaml_plugin) \
options.mli options.ml \
main.mli main.ml

39
ocamltest/actions.ml
View File

@ -29,23 +29,27 @@ let string_of_result = function
| Fail reason -> string_of_reason "Fail" reason
| Skip reason -> string_of_reason "Skip" reason
type body = out_channel -> Environments.t -> result
type code = out_channel -> Environments.t -> result
type t = {
action_name : string;
action_environment : Environments.t -> Environments.t;
action_body : body
name : string;
body : code;
mutable hook : code option
}
let compare a1 a2 = String.compare a1.action_name a2.action_name
let action_name a = a.name
let make n c = { name = n; body = c; hook = None }
let compare a1 a2 = String.compare a1.name a2.name
let (actions : (string, t) Hashtbl.t) = Hashtbl.create 10
let register action =
Hashtbl.add actions action.action_name action
Hashtbl.add actions action.name action
let get_registered_actions () =
let f _action_name action acc = action::acc in
let f _name action acc = action::acc in
let unsorted_actions = Hashtbl.fold f actions [] in
List.sort compare unsorted_actions
@ -53,15 +57,26 @@ let lookup name =
try Some (Hashtbl.find actions name)
with Not_found -> None
let set_hook name hook =
let action = (Hashtbl.find actions name) in
action.hook <- Some hook
let clear_hook name =
let action = (Hashtbl.find actions name) in
action.hook <- None
let clear_all_hooks () =
let f _name action = action.hook <- None in
Hashtbl.iter f actions
let run log env action =
action.action_body log env
let code = match action.hook with
| None -> action.body
| Some code -> code in
code log env
module ActionSet = Set.Make
(struct
type nonrec t = t
let compare = compare
end)
let update_environment initial_env actions =
let f act env = act.action_environment env in
ActionSet.fold f actions initial_env

18
ocamltest/actions.mli
View File

@ -22,13 +22,13 @@ type result =
val string_of_result : result -> string
type body = out_channel -> Environments.t -> result
type code = out_channel -> Environments.t -> result
type t = {
action_name : string;
action_environment : Environments.t -> Environments.t;
action_body : body
}
type t
val action_name : t -> string
val make : string -> code -> t
val compare : t -> t -> int
@ -38,8 +38,10 @@ val get_registered_actions : unit -> t list
val lookup : string -> t option
val set_hook : string -> code -> unit
val clear_hook : string -> unit
val clear_all_hooks : unit -> unit
val run : out_channel -> Environments.t -> t -> result
module ActionSet : Set.S with type elt = t
val update_environment : Environments.t -> ActionSet.t -> Environments.t

250
ocamltest/actions_helpers.ml Normal file
View File

@ -0,0 +1,250 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Helper functions when writing actions *)
open Ocamltest_stdlib
open Actions
let mkreason what commandline exitcode =
Printf.sprintf "%s: command\n%s\nfailed with exit code %d"
what commandline exitcode
let testfile env =
match Environments.lookup Builtin_variables.test_file env with
| None -> assert false
| Some t -> t
let test_source_directory env =
Environments.safe_lookup Builtin_variables.test_source_directory env
let test_build_directory env =
Environments.safe_lookup Builtin_variables.test_build_directory env
let words_of_variable env variable =
String.words (Environments.safe_lookup variable env)
let files env = words_of_variable env Builtin_variables.files
let setup_symlinks test_source_directory build_directory files =
let symlink filename =
let src = Filename.concat test_source_directory filename in
let cmd = "ln -sf " ^ src ^" " ^ build_directory in
Sys.run_system_command cmd in
let copy filename =
let src = Filename.concat test_source_directory filename in
let dst = Filename.concat build_directory filename in
Sys.copy_file src dst in
let f = if Sys.os_type="Win32" then copy else symlink in
Sys.make_directory build_directory;
List.iter f files
let setup_build_env add_testfile additional_files (_log : out_channel) env =
let build_dir = (test_build_directory env) in
let some_files = additional_files @ (files env) in
let files =
if add_testfile
then (testfile env) :: some_files
else some_files in
setup_symlinks (test_source_directory env) build_dir files;
Sys.chdir build_dir;
Pass env
let run_cmd
?(environment=[||])
?(stdin_variable=Builtin_variables.stdin)
?(stdout_variable=Builtin_variables.stdout)
?(stderr_variable=Builtin_variables.stderr)
?(append=false)
?(timeout=0)
log env cmd
=
let log_redirection std filename =
if filename<>"" then
begin
Printf.fprintf log " Redirecting %s to %s \n%!" std filename
end in
let lst = List.concat (List.map String.words cmd) in
let quoted_lst =
if Sys.os_type="Win32"
then List.map Filename.maybe_quote lst
else lst in
let cmd' = String.concat " " quoted_lst in
Printf.fprintf log "Commandline: %s\n" cmd';
let progname = List.hd quoted_lst in
let arguments = Array.of_list quoted_lst in
let stdin_filename = Environments.safe_lookup stdin_variable env in
let stdout_filename = Environments.safe_lookup stdout_variable env in
let stderr_filename = Environments.safe_lookup stderr_variable env in
log_redirection "stdin" stdin_filename;
log_redirection "stdout" stdout_filename;
log_redirection "stderr" stderr_filename;
Run_command.run {
Run_command.progname = progname;
Run_command.argv = arguments;
Run_command.envp = environment;
Run_command.stdin_filename = stdin_filename;
Run_command.stdout_filename = stdout_filename;
Run_command.stderr_filename = stderr_filename;
Run_command.append = append;
Run_command.timeout = timeout;
Run_command.log = log
}
let caml_ld_library_path = "CAML_LD_LIBRARY_PATH"
let string_of_binding variable value =
if variable=Builtin_variables.ld_library_path then begin
let current_value =
try Sys.getenv caml_ld_library_path with Not_found -> "" in
let local_value =
(String.concat Filename.path_sep (String.words value)) in
let new_value =
if local_value="" then current_value else
if current_value="" then local_value else
String.concat Filename.path_sep [local_value; current_value] in
Printf.sprintf "%s=%s" caml_ld_library_path new_value
end else Environments.string_of_binding variable value
let run
(log_message : string)
(redirect_output : bool)
(can_skip : bool)
(prog_variable : Variables.t)
(args_variable : Variables.t option)
(log : out_channel)
(env : Environments.t)
=
match Environments.lookup prog_variable env with
| None ->
let msg = Printf.sprintf "%s: variable %s is undefined"
log_message (Variables.name_of_variable prog_variable) in
Fail msg
| Some program ->
let arguments = match args_variable with
| None -> ""
| Some variable -> Environments.safe_lookup variable env in
let commandline = [program; arguments] in
let what = log_message ^ " " ^ program ^ " " ^
begin if arguments="" then "without any argument"
else "with arguments " ^ arguments
end in
let output = program ^ ".output" in
let execution_env =
if redirect_output then begin
let bindings =
[
Builtin_variables.stdout, output;
Builtin_variables.stderr, output
] in
Environments.add_bindings bindings env
end else env in
let systemenv =
Environments.to_system_env ~f:string_of_binding execution_env in
match run_cmd ~environment:systemenv log execution_env commandline with
| 0 ->
let newenv =
if redirect_output
then Environments.add Builtin_variables.output output env
else env in
Pass newenv
| _ as exitcode ->
if exitcode = 125 && can_skip
then Skip (mkreason
what (String.concat " " commandline) exitcode)
else Fail (mkreason
what (String.concat " " commandline) exitcode)
let run_program =
run
"Running program"
true
false
Builtin_variables.program
(Some Builtin_variables.arguments)
let run_script =
run
"Running script"
false
true
Builtin_variables.script
None
let run_hook hook_name log input_env =
Printf.fprintf log "Entering run_hook for hook %s\n%!" hook_name;
let envfile = Filename.temp_file "ocamltest-" ".env" in
Printf.fprintf log "Hook should write environemnt modifiers to %s\n%!"
envfile;
let hookenv = Environments.add
Builtin_variables.ocamltest_env envfile input_env in
let systemenv =
Environments.to_system_env ~f:string_of_binding hookenv in
let open Run_command in
let settings = {
progname = "sh";
argv = [|"sh"; Filename.maybe_quote hook_name|];
envp = systemenv;
stdin_filename = "";
stdout_filename = "";
stderr_filename = "";
append = false;
timeout = 0;
log = log;
} in let exit_status = run settings in
match exit_status with
| 0 ->
let modifiers = Environments.modifiers_of_file envfile in
Pass (Environments.apply_modifiers hookenv modifiers)
| _ ->
let msg = Printf.sprintf "Hook returned %d" exit_status in
if exit_status=125 then Skip msg else Fail msg
let check_output kind_of_output output_variable reference_variable log env =
let reference_filename = Environments.safe_lookup reference_variable env in
let output_filename = Environments.safe_lookup output_variable env in
Printf.fprintf log "Comparing %s output %s to reference %s\n%!"
kind_of_output output_filename reference_filename;
let files =
{
Filecompare.filetype = Filecompare.Text;
Filecompare.reference_filename = reference_filename;
Filecompare.output_filename = output_filename
} in
match Filecompare.check_file files with
| Filecompare.Same -> Pass env
| Filecompare.Different ->
let diff = Filecompare.diff files in
let diffstr = match diff with
| Ok difference -> difference
| Error diff_file -> ("See " ^ diff_file) in
let reason =
Printf.sprintf "%s output %s differs from reference %s: \n%s\n"
kind_of_output output_filename reference_filename diffstr in
(Fail reason)
| Filecompare.Unexpected_output ->
let banner = String.make 40 '=' in
let unexpected_output = Sys.string_of_file output_filename in
let unexpected_output_with_banners = Printf.sprintf
"%s\n%s%s\n" banner unexpected_output banner in
let reason = Printf.sprintf
"The file %s was expected to be empty because there is no \
reference file %s but it is not:\n%s\n"
output_filename reference_filename unexpected_output_with_banners in
(Fail reason)
| Filecompare.Error (commandline, exitcode) ->
let reason = Printf.sprintf "The command %s failed with status %d"
commandline exitcode in
(Fail reason)

38
ocamltest/testlib.mli → ocamltest/actions_helpers.mli
View File

@ -13,24 +13,40 @@
(* *)
(**************************************************************************)
(* Miscellaneous library functions *)
(* Helper functions when writing actions *)
val concatmap : ('a -> 'b list) -> 'a list -> 'b list
val mkreason : string -> string -> int -> string
val is_blank : char -> bool
val testfile : Environments.t -> string
val maybe_quote : string -> string
val test_build_directory : Environments.t -> string
val words : string -> string list
val test_source_directory : Environments.t -> string
val file_is_empty : string -> bool
val words_of_variable : Environments.t -> Variables.t -> string list
val string_of_location: Location.t -> string
val files : Environments.t -> string list
val run_system_command : string -> unit
val setup_symlinks : string -> string -> string list -> unit
val make_directory : string -> unit
val setup_build_env : bool -> string list -> Actions.code
val string_of_file : string -> string
val run_cmd :
?environment : string array ->
?stdin_variable : Variables.t ->
?stdout_variable : Variables.t ->
?stderr_variable : Variables.t ->
?append : bool ->
?timeout : int ->
out_channel -> Environments.t -> string list -> int
val copy_file : string -> string -> unit
val run : string -> bool -> bool -> Variables.t
-> Variables.t option -> Actions.code
val run_program : Actions.code
val run_script : Actions.code
val run_hook : string -> Actions.code
val check_output : string -> Variables.t -> Variables.t -> Actions.code

936
ocamltest/builtin_actions.ml
View File

@ -15,929 +15,89 @@
(* Definition of a few built-in actions *)
open Ocamltest_stdlib
open Actions
(* Miscellaneous functions *)
let env_id env = env
let pass = {
action_name = "pass";
action_environment = env_id;
action_body = fun log env ->
let pass = make
"pass"
(fun log env ->
Printf.fprintf log "The pass action always succeeds.\n%!";
Pass env
}
Pass env)
let skip = {
action_name = "skip";
action_environment = env_id;
action_body = fun _log _env -> Skip "The skip action always skips."
}
let skip = make
"skip"
(fun _log _env -> Skip "The skip action always skips.")
let fail = {
action_name = "fail";
action_environment = env_id;
action_body = fun _log _env -> Fail "The fail action always fails."
}
let fail = make
"fail"
(fun _log _env -> Fail "The fail action always fails.")
let unix = {
action_name = "unix";
action_environment = env_id;
action_body = fun log env ->
let dumpenv = make
"dumpenv"
(fun log env ->
Environments.dump log env; Pass env)
let unix = make
"unix"
(fun log env ->
if Ocamltest_config.unix then
begin
Printf.fprintf log
"The unix action succeeds because we are on a Unix system.\n%!";
Pass env
end else
Skip "The unix action skips because we are on a Windows system."
}
Skip "The unix action skips because we are on a Windows system.")
let windows = {
action_name = "windows";
action_environment = env_id;
action_body = fun log env ->
let windows = make
"windows"
(fun log env ->
if not Ocamltest_config.unix then
begin
Printf.fprintf log
"The windows action succeeds because we are on a Windows system.\n%!";
Pass env
end else
Skip "The windows action skips because we are on a Unix system."
}
Skip "The windows action skips because we are on a Unix system.")
let run_command
?(stdin_variable=Builtin_variables.stdin)
?(stdout_variable=Builtin_variables.stdout)
?(stderr_variable=Builtin_variables.stderr)
?(append=false)
?(timeout=0)
log env cmd
=
let log_redirection std filename =
if filename<>"" then
begin
Printf.fprintf log " Redirecting %s to %s \n%!" std filename
end in
let lst = List.concat (List.map Testlib.words cmd) in
let quoted_lst =
if Sys.os_type="Win32"
then List.map Testlib.maybe_quote lst
else lst in
let cmd' = String.concat " " quoted_lst in
Printf.fprintf log "Commandline: %s\n" cmd';
let progname = List.hd quoted_lst in
let arguments = Array.of_list quoted_lst in
(*
let environment =
try [|Sys.getenv "PATH" |]
with Not_found -> [| |] in
*)
let stdin_filename = Environments.safe_lookup stdin_variable env in
let stdout_filename = Environments.safe_lookup stdout_variable env in
let stderr_filename = Environments.safe_lookup stderr_variable env in
log_redirection "stdin" stdin_filename;
log_redirection "stdout" stdout_filename;
log_redirection "stderr" stderr_filename;
Run_command.run {
Run_command.progname = progname;
Run_command.argv = arguments;
(* Run_command.envp = environment; *)
Run_command.stdin_filename = stdin_filename;
Run_command.stdout_filename = stdout_filename;
Run_command.stderr_filename = stderr_filename;
Run_command.append = append;
Run_command.timeout = timeout;
Run_command.log = log
}
let setup_build_env = make
"setup-build-env"
(Actions_helpers.setup_build_env true [])
let mkreason what commandline exitcode =
Printf.sprintf "%s: command\n%s\nfailed with exit code %d"
what commandline exitcode
let run = make
"run"
Actions_helpers.run_program
let make_file_name name ext = String.concat "." [name; ext]
let script = make
"script"
Actions_helpers.run_script
let make_path components = List.fold_left Filename.concat "" components
(*
let rec map_reduce_result f g init = function
| [] -> Ok init
| x::xs ->
(match f x with
| Ok fx ->
(match map_reduce_result f g init xs with
| Ok fxs -> Ok (g fx fxs)
| Error _ as e -> e
)
| Error _ as e -> e
)
*)
let setup_symlinks test_source_directory build_directory files =
let symlink filename =
let src = Filename.concat test_source_directory filename in
let cmd = "ln -sf " ^ src ^" " ^ build_directory in
Testlib.run_system_command cmd in
let copy filename =
let src = Filename.concat test_source_directory filename in
let dst = Filename.concat build_directory filename in
Testlib.copy_file src dst in
let f = if Sys.os_type="Win32" then copy else symlink in
List.iter f files
let mkexe =
if Sys.os_type="Win32"
then fun name -> make_file_name name "exe"
else fun name -> name
(* Compilers and flags *)
let ocamlsrcdir () =
try Sys.getenv "OCAMLSRCDIR"
with Not_found -> Ocamltest_config.ocamlsrcdir
type runtime_variant =
| Normal
| Debug
| Instrumented
let runtime_variant() =
let use_runtime = try Sys.getenv "USE_RUNTIME" with Not_found -> "" in
if use_runtime="d" then Debug
else if use_runtime="i" then Instrumented
else Normal
let ocamlrun ocamlsrcdir =
let runtime = match runtime_variant () with
| Normal -> "ocamlrun"
| Debug -> "ocamlrund"
| Instrumented -> "ocamlruni" in
let ocamlrunfile = mkexe runtime in
make_path [ocamlsrcdir; "byterun"; ocamlrunfile]
let ocamlc ocamlsrcdir =
make_path [ocamlsrcdir; "ocamlc"]
let ocaml ocamlsrcdir =
make_path [ocamlsrcdir; "ocaml"]
let ocamlc_dot_byte ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let ocamlc = ocamlc ocamlsrcdir in
ocamlrun ^ " " ^ ocamlc
let ocamlc_dot_opt ocamlsrcdir =
make_path [ocamlsrcdir; "ocamlc.opt"]
let ocamlopt ocamlsrcdir =
make_path [ocamlsrcdir; "ocamlopt"]
let ocamlopt_dot_byte ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let ocamlopt = ocamlopt ocamlsrcdir in
ocamlrun ^ " " ^ ocamlopt
let ocamlopt_dot_opt ocamlsrcdir =
make_path [ocamlsrcdir; "ocamlopt.opt"]
let ocaml_dot_byte ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let ocaml = ocaml ocamlsrcdir in
ocamlrun ^ " " ^ ocaml
let ocaml_dot_opt ocamlsrcdir =
make_path [ocamlsrcdir; mkexe "ocamlnat"]
let cmpbyt ocamlsrcdir =
make_path [ocamlsrcdir; "tools"; "cmpbyt"]
let stdlib ocamlsrcdir =
make_path [ocamlsrcdir; "stdlib"]
let stdlib_flags ocamlsrcdir =
let stdlib_path = stdlib ocamlsrcdir in
"-nostdlib -I " ^ stdlib_path
let c_includes ocamlsrcdir =
make_path [ocamlsrcdir; "byterun"]
let c_includes_flags ocamlsrcdir =
let dir = c_includes ocamlsrcdir in
"-ccopt -I" ^ dir
let use_runtime backend ocamlsrcdir = match backend with
| Sys.Bytecode ->
let ocamlrun = ocamlrun ocamlsrcdir in
"-use-runtime " ^ ocamlrun
| _ -> ""
let runtime_variant_flags backend ocamlsrcdir =
let variant = runtime_variant() in
if variant=Normal then ""
else begin
let variant_str = if variant=Debug then "d" else "i" in
let backend_lib = match backend with
| Sys.Bytecode -> "byterun"
| Sys.Native -> "asmrun"
| Sys.Other _ -> "stdlib" in
let backend_lib_dir = make_path [ocamlsrcdir; backend_lib] in
("-runtime-variant " ^ variant_str ^" -I " ^ backend_lib_dir)
end
(* Compiler descriptions *)
type compiler_info = {
compiler_name : string -> string;
compiler_flags : string;
compiler_directory : string;
compiler_backend : Sys.backend_type;
compiler_exit_status_variabe : Variables.t;
compiler_reference_variable : Variables.t;
compiler_output_variable : Variables.t
}
(* Compilers compiling byte-code programs *)
let bytecode_bytecode_compiler =
{
compiler_name = ocamlc_dot_byte;
compiler_flags = "";
compiler_directory = "ocamlc.byte";
compiler_backend = Sys.Bytecode;
compiler_exit_status_variabe = Builtin_variables.ocamlc_byte_exit_status;
compiler_reference_variable = Builtin_variables.compiler_reference;
compiler_output_variable = Builtin_variables.compiler_output;
}
let bytecode_native_compiler =
{
compiler_name = ocamlc_dot_opt;
compiler_flags = "";
compiler_directory = "ocamlc.opt";
compiler_backend = Sys.Bytecode;
compiler_exit_status_variabe = Builtin_variables.ocamlc_opt_exit_status;
compiler_reference_variable = Builtin_variables.compiler_reference2;
compiler_output_variable = Builtin_variables.compiler_output2;
}
(* Compilers compiling native-code programs *)
let native_bytecode_compiler =
{
compiler_name = ocamlopt_dot_byte;
compiler_flags = "";
compiler_directory = "ocamlopt.byte";
compiler_backend = Sys.Native;
compiler_exit_status_variabe = Builtin_variables.ocamlopt_byte_exit_status;
compiler_reference_variable = Builtin_variables.compiler_reference;
compiler_output_variable = Builtin_variables.compiler_output;
}
let native_native_compiler =
{
compiler_name = ocamlopt_dot_opt;
compiler_flags = "";
compiler_directory = "ocamlopt.opt";
compiler_backend = Sys.Native;
compiler_exit_status_variabe = Builtin_variables.ocamlopt_opt_exit_status;
compiler_reference_variable = Builtin_variables.compiler_reference2;
compiler_output_variable = Builtin_variables.compiler_output2;
}
(* Top-levels *)
let ocaml = {
compiler_name = ocaml_dot_byte;
compiler_flags = "";
compiler_directory = "ocaml";
compiler_backend = Sys.Bytecode;
compiler_exit_status_variabe = Builtin_variables.ocaml_byte_exit_status;
compiler_reference_variable = Builtin_variables.compiler_reference;
compiler_output_variable = Builtin_variables.compiler_output;
}
let ocamlnat = {
compiler_name = ocaml_dot_opt;
compiler_flags = "-S"; (* Keep intermediate assembly files *)
compiler_directory = "ocamlnat";
compiler_backend = Sys.Native;
compiler_exit_status_variabe = Builtin_variables.ocaml_opt_exit_status;
compiler_reference_variable = Builtin_variables.compiler_reference2;
compiler_output_variable = Builtin_variables.compiler_output2;
}
let expected_compiler_exit_status env compiler =
try int_of_string
(Environments.safe_lookup compiler.compiler_exit_status_variabe env)
with _ -> 0
let compiler_reference_filename env prefix compiler =
let compiler_reference_suffix =
Environments.safe_lookup Builtin_variables.compiler_reference_suffix env in
let suffix =
if compiler_reference_suffix<>""
then compiler_reference_suffix ^ ".reference"
else ".reference" in
let mk s = (make_file_name prefix s) ^suffix in
let filename = mk compiler.compiler_directory in
if Sys.file_exists filename then filename else
let filename = mk (Backends.string_of_backend compiler.compiler_backend) in
if Sys.file_exists filename then filename else
mk "compilers"
(* Extracting information from environment *)
let get_backend_value_from_env env bytecode_var native_var =
Backends.make_backend_function
(Environments.safe_lookup bytecode_var env)
(Environments.safe_lookup native_var env)
let testfile env =
match Environments.lookup Builtin_variables.test_file env with
| None -> assert false
| Some t -> t
let words_of_variable variable env =
Testlib.words (Environments.safe_lookup variable env)
let modules env = words_of_variable Builtin_variables.modules env
let files env = words_of_variable Builtin_variables.files env
let flags env = Environments.safe_lookup Builtin_variables.flags env
let libraries backend env =
let value = Environments.safe_lookup Builtin_variables.libraries env in
let libs = Testlib.words value in
let extension = Backends.library_extension backend in
let add_extension lib = make_file_name lib extension in
String.concat " " (List.map add_extension libs)
let backend_default_flags env =
get_backend_value_from_env env
Builtin_variables.ocamlc_default_flags
Builtin_variables.ocamlopt_default_flags
let backend_flags env =
get_backend_value_from_env env
Builtin_variables.ocamlc_flags
Builtin_variables.ocamlopt_flags
let test_source_directory env =
Environments.safe_lookup Builtin_variables.test_source_directory env
let test_build_directory env =
Environments.safe_lookup Builtin_variables.test_build_directory env
(*
let action_of_filetype = function
| Filetype.Implementation -> "Compiling implementation"
| Filetype.Interface -> "Compiling interface"
| Filetype.C -> "Compiling C source file"
| Filetype.C_minus_minus -> "Processing C minus minus file"
| Filetype.Lexer -> "Generating lexer"
| Filetype.Grammar -> "Generating parser"
*)
let link_modules
ocamlsrcdir compiler compilername compileroutput program_variable
custom c_headers_flags log env modules
=
let backend = compiler.compiler_backend in
let expected_exit_status = expected_compiler_exit_status env compiler in
let executable_name = match Environments.lookup program_variable env with
| None -> assert false
| Some program -> program in
let module_names =
String.concat " " (List.map Filetype.make_filename modules) in
let what = Printf.sprintf "Linking modules %s into %s"
module_names executable_name in
Printf.fprintf log "%s\n%!" what;
let output = "-o " ^ executable_name in
let customstr = if custom then "-custom" else "" in
let commandline =
[
compilername;
customstr;
c_headers_flags;
use_runtime backend ocamlsrcdir;
runtime_variant_flags backend ocamlsrcdir;
stdlib_flags ocamlsrcdir;
"-linkall";
flags env;
libraries backend env;
backend_default_flags env backend;
backend_flags env backend;
output;
module_names
] in
let exit_status =
run_command
~stdout_variable:compileroutput
~stderr_variable:compileroutput
~append:true
log env commandline in
if exit_status=expected_exit_status
then Pass env
else Fail (mkreason what (String.concat " " commandline) exit_status)
let compile_program
ocamlsrcdir compiler compilername compileroutput program_variable
log env modules
=
let is_c_file (_filename, filetype) = filetype=Filetype.C in
let has_c_file = List.exists is_c_file modules in
let backend = compiler.compiler_backend in
let custom = (backend = Sys.Bytecode) && has_c_file in
let c_headers_flags =
if has_c_file then c_includes_flags ocamlsrcdir else "" in
link_modules
ocamlsrcdir compiler compilername compileroutput
program_variable custom c_headers_flags log env modules
let module_has_interface directory module_name =
let interface_name =
Filetype.make_filename (module_name, Filetype.Interface) in
let interface_fullpath = make_path [directory;interface_name] in
Sys.file_exists interface_fullpath
let add_module_interface directory module_description =
match module_description with
| (filename, Filetype.Implementation) when
module_has_interface directory filename ->
[(filename, Filetype.Interface); module_description]
| _ -> [module_description]
let print_module_names log description modules =
Printf.fprintf log "%s modules: %s\n%!"
description
(String.concat " " (List.map Filetype.make_filename modules))
let setup_build_environment
testfile source_directory build_directory log env
=
let specified_modules =
List.map Filetype.filetype ((modules env) @ [testfile]) in
print_module_names log "Specified" specified_modules;
let source_modules =
Testlib.concatmap
(add_module_interface source_directory)
specified_modules in
print_module_names log "Source" source_modules;
Testlib.make_directory build_directory;
setup_symlinks
source_directory
build_directory
(List.map Filetype.make_filename source_modules);
setup_symlinks source_directory build_directory (files env);
Sys.chdir build_directory;
source_modules
let prepare_module (module_name, module_type) =
match module_type with
| Filetype.Implementation | Filetype.Interface | Filetype.C ->
[(module_name, module_type)]
| Filetype.C_minus_minus -> assert false
| Filetype.Lexer -> assert false
| Filetype.Grammar -> assert false
let compile_test_program program_variable compiler log env =
let backend = compiler.compiler_backend in
let testfile = testfile env in
let testfile_basename = Filename.chop_extension testfile in
let source_directory = test_source_directory env in
let compiler_directory_suffix =
Environments.safe_lookup Builtin_variables.compiler_directory_suffix env in
let compiler_directory_name =
compiler.compiler_directory ^ compiler_directory_suffix in
let build_directory =
make_path [test_build_directory env; compiler_directory_name] in
let compilerreference_prefix =
make_path [source_directory; testfile_basename] in
let compilerreference_filename =
compiler_reference_filename env compilerreference_prefix compiler in
let compiler_reference_variable = compiler.compiler_reference_variable in
let executable_filename =
mkexe
(make_file_name
testfile_basename (Backends.executable_extension backend)) in
let executable_path = make_path [build_directory; executable_filename] in
let compiler_output_filename =
make_file_name compiler.compiler_directory "output" in
let compiler_output =
make_path [build_directory; compiler_output_filename] in
let compiler_output_variable = compiler.compiler_output_variable in
let newenv = Environments.add_bindings
[
(program_variable, executable_path);
(compiler_reference_variable, compilerreference_filename);
(compiler_output_variable, compiler_output);
] env in
if Sys.file_exists compiler_output_filename then
Sys.remove compiler_output_filename;
let ocamlsrcdir = ocamlsrcdir () in
let compilername = compiler.compiler_name ocamlsrcdir in
let source_modules =
setup_build_environment
testfile source_directory build_directory log env in
let prepared_modules =
Testlib.concatmap prepare_module source_modules in
compile_program
ocamlsrcdir
compiler
compilername
compiler_output_variable
program_variable log newenv prepared_modules
(* Compile actions *)
let compile_bytecode_with_bytecode_compiler = {
action_name = "ocamlc.byte";
action_environment = env_id;
action_body =
compile_test_program
Builtin_variables.program bytecode_bytecode_compiler
}
let compile_bytecode_with_native_compiler = {
action_name = "ocamlc.opt";
action_environment = env_id;
action_body =
compile_test_program
Builtin_variables.program2 bytecode_native_compiler
}
let compile_native_with_bytecode_compiler = {
action_name = "ocamlopt.byte";
action_environment = env_id;
action_body =
compile_test_program
Builtin_variables.program native_bytecode_compiler
}
let compile_native_with_native_compiler = {
action_name = "ocamlopt.opt";
action_environment = env_id;
action_body =
compile_test_program
Builtin_variables.program2 native_native_compiler
}
let exec log_message redirect_output prog_variable args_variable log env =
match Environments.lookup prog_variable env with
| None ->
let msg = Printf.sprintf "%s: variable %s is undefined"
log_message (Variables.name_of_variable prog_variable) in
Fail msg
| Some program ->
let arguments = Environments.safe_lookup args_variable env in
let commandline = [program; arguments] in
let what = log_message ^ " " ^ program ^ " " ^
begin if arguments="" then "without any argument"
else "with arguments " ^ arguments
end in
let output = program ^ ".output" in
let bindings =
[
Builtin_variables.stdout, output;
Builtin_variables.stderr, output
] in
let execution_env =
if redirect_output then Environments.add_bindings bindings env
else env in
match run_command log execution_env commandline with
| 0 ->
let newenv =
if redirect_output
then Environments.add Builtin_variables.output output env
else env in
Pass newenv
| _ as exitcode ->
if exitcode = 125
then Skip (mkreason what (String.concat " " commandline) exitcode)
else Fail (mkreason what (String.concat " " commandline) exitcode)
let execute_program =
exec
"Executing program"
true
Builtin_variables.program
Builtin_variables.arguments
let execute = {
action_name = "run";
action_environment = env_id;
action_body = execute_program
}
let run_script log env =
let testfile = testfile env in
(* let testfile_basename = Filename.chop_extension testfile in *)
let source_directory = test_source_directory env in
let build_directory = test_build_directory env in
let _modules =
setup_build_environment
testfile source_directory build_directory log env in
exec
"Running script"
false
Builtin_variables.script
Builtin_variables.test_file
log env
let script = {
action_name = "script";
action_environment = env_id;
action_body = run_script
}
let run_expect log env =
let newenv = Environments.apply_modifiers env Builtin_modifiers.expect in
run_script log newenv
let expect = {
action_name = "expect";
action_environment = env_id;
action_body = run_expect
}
let check_output kind_of_output output_variable reference_variable log env =
let reference_filename = Environments.safe_lookup reference_variable env in
let output_filename = Environments.safe_lookup output_variable env in
Printf.fprintf log "Comparing %s output %s to reference %s\n%!"
kind_of_output output_filename reference_filename;
let files =
{
Filecompare.filetype = Filecompare.Text;
Filecompare.reference_filename = reference_filename;
Filecompare.output_filename = output_filename
} in
match Filecompare.check_file files with
| Filecompare.Same -> Pass env
| Filecompare.Different ->
let diff = Filecompare.diff files in
let diffstr = match diff with
| Ok difference -> difference
| Error diff_file -> ("See " ^ diff_file) in
let reason =
Printf.sprintf "%s output %s differs from reference %s: \n%s\n"
kind_of_output output_filename reference_filename diffstr in
(Actions.Fail reason)
| Filecompare.Unexpected_output ->
let banner = String.make 40 '=' in
let unexpected_output = Testlib.string_of_file output_filename in
let unexpected_output_with_banners = Printf.sprintf
"%s\n%s%s\n" banner unexpected_output banner in
let reason = Printf.sprintf
"The file %s was expected to be empty because there is no \
reference file %s but it is not:\n%s\n"
output_filename reference_filename unexpected_output_with_banners in
(Actions.Fail reason)
| Filecompare.Error (commandline, exitcode) ->
let reason = Printf.sprintf "The command %s failed with status %d"
commandline exitcode in
(Actions.Fail reason)
let make_check_compiler_output name compiler = {
action_name = name;
action_environment = env_id;
action_body =
check_output
"compiler"
compiler.compiler_output_variable
compiler.compiler_reference_variable
}
let check_ocamlc_dot_byte_output = make_check_compiler_output
"check-ocamlc-byte-output" bytecode_bytecode_compiler
let check_ocamlc_dot_opt_output = make_check_compiler_output
"check-ocamlc-opt-output" bytecode_native_compiler
let check_ocamlopt_dot_byte_output = make_check_compiler_output
"check-ocamlopt-byte-output" native_bytecode_compiler
let check_ocamlopt_dot_opt_output = make_check_compiler_output
"check-ocamlopt-opt-output" native_native_compiler
let check_program_output = {
action_name = "check-program-output";
action_environment = env_id;
action_body = check_output "program"
let check_program_output = make
"check-program-output"
(Actions_helpers.check_output "program"
Builtin_variables.output
Builtin_variables.reference
}
Builtin_variables.reference)
(*
let comparison_start_address portable_executable_filename =
let portable_executalbe_signature = "PE\000\000" in
let signature_length = String.length portable_executalbe_signature in
let address_length = 4 in
let start_address = 0x3c in
let ic = open_in portable_executable_filename in
seek_in ic start_address;
let portable_executable_signature_address_str =
really_input_string ic address_length in
let b0 = int_of_char portable_executable_signature_address_str.[0] in
let b1 = int_of_char portable_executable_signature_address_str.[1] in
let b2 = int_of_char portable_executable_signature_address_str.[2] in
let b3 = int_of_char portable_executable_signature_address_str.[3] in
let signature_address =
b0 +
b1 * 256 +
b2 * 256 * 256 +
b3 * 256 * 256 * 256 in
seek_in ic signature_address;
let signature =
really_input_string ic signature_length in
if signature<>portable_executalbe_signature
then failwith
(portable_executable_filename ^ " does not contain the PE signature");
let result = signature_address + 12 in
(* 12 is 4-bytes signature, 2-bytes machine type, *)
(* 2-bytes number of sections, 4-bytes timestamp *)
close_in ic;
result
*)
let compare_programs backend comparison_tool log env =
let program = Environments.safe_lookup Builtin_variables.program env in
let program2 = Environments.safe_lookup Builtin_variables.program2 env in
let what = Printf.sprintf "Comparing %s programs %s and %s"
(Backends.string_of_backend backend) program program2 in
Printf.fprintf log "%s\n%!" what;
let files = {
Filecompare.filetype = Filecompare.Binary;
Filecompare.reference_filename = program;
Filecompare.output_filename = program2
} in
if Ocamltest_config.flambda && backend = Sys.Native
then begin
Printf.fprintf log
"flambda temporarily disables comparison of native programs";
Pass env
end else if backend = Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
then begin
Printf.fprintf log
"comparison of native programs temporarily disabled under Windows";
Pass env
end else begin
let comparison_tool =
if backend=Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
then
let bytes_to_ignore = 512 (* comparison_start_address program *) in
Filecompare.make_cmp_tool bytes_to_ignore
else comparison_tool in
match Filecompare.compare_files ~tool:comparison_tool files with
| Filecompare.Same -> Pass env
| Filecompare.Different ->
let reason = Printf.sprintf "Files %s and %s are different"
program program2 in
Fail reason
| Filecompare.Unexpected_output -> assert false
| Filecompare.Error (commandline, exitcode) ->
let reason = mkreason what commandline exitcode in
Fail reason
end
let make_bytecode_programs_comparison_tool ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let cmpbyt = cmpbyt ocamlsrcdir in
let tool_name = ocamlrun ^ " " ^ cmpbyt in
Filecompare.make_comparison_tool tool_name ""
let native_programs_comparison_tool = Filecompare.default_comparison_tool
let compare_bytecode_programs_body log env =
let ocamlsrcdir = ocamlsrcdir () in
let bytecode_programs_comparison_tool =
make_bytecode_programs_comparison_tool ocamlsrcdir in
compare_programs Sys.Bytecode bytecode_programs_comparison_tool log env
let compare_bytecode_programs = {
action_name = "compare-bytecode-programs";
action_environment = env_id;
action_body = compare_bytecode_programs_body
}
let compare_native_programs = {
action_name = "compare-native-programs";
action_environment = env_id;
action_body = compare_programs Sys.Native native_programs_comparison_tool
}
let run_test_program_in_toplevel toplevel log env =
let testfile = testfile env in
let testfile_basename = Filename.chop_extension testfile in
let expected_exit_status = expected_compiler_exit_status env toplevel in
let what =
Printf.sprintf "Running %s in %s toplevel (expected exit status: %d)"
testfile
(Backends.string_of_backend toplevel.compiler_backend)
expected_exit_status in
Printf.fprintf log "%s\n%!" what;
let source_directory = test_source_directory env in
let compiler_directory_suffix =
Environments.safe_lookup Builtin_variables.compiler_directory_suffix env in
let compiler_directory_name =
toplevel.compiler_directory ^ compiler_directory_suffix in
let build_directory =
make_path [test_build_directory env; compiler_directory_name] in
let _modules =
setup_build_environment
testfile source_directory build_directory log env in
let compilerreference_prefix =
make_path [source_directory; testfile_basename] in
let compilerreference_filename =
compiler_reference_filename env compilerreference_prefix toplevel in
let compiler_reference_variable = toplevel.compiler_reference_variable in
let compiler_output_filename =
make_file_name toplevel.compiler_directory "output" in
let compiler_output =
make_path [build_directory; compiler_output_filename] in
let compiler_output_variable = toplevel.compiler_output_variable in
let newenv = Environments.add_bindings
[
(compiler_reference_variable, compilerreference_filename);
(compiler_output_variable, compiler_output);
] env in
if Sys.file_exists compiler_output_filename then
Sys.remove compiler_output_filename;
let ocamlsrcdir = ocamlsrcdir () in
let toplevel_name = toplevel.compiler_name ocamlsrcdir in
let toplevel_default_flags = "-noinit -no-version -noprompt" in
let commandline =
let initialize_test_exit_status_variables _log env =
Environments.add_bindings
[
toplevel_name;
toplevel_default_flags;
toplevel.compiler_flags;
stdlib_flags ocamlsrcdir;
flags env;
] in
let exit_status =
run_command
~stdin_variable:Builtin_variables.test_file
~stdout_variable:compiler_output_variable
~stderr_variable:compiler_output_variable
log newenv commandline in
if exit_status=expected_exit_status
then Pass newenv
else Fail (mkreason what (String.concat " " commandline) exit_status)
let run_in_ocaml =
{
action_name = "ocaml";
action_environment = env_id;
action_body = run_test_program_in_toplevel ocaml;
}
let run_in_ocamlnat =
{
action_name = "ocamlnat";
action_environment = env_id;
action_body = run_test_program_in_toplevel ocamlnat;
}
let check_ocaml_output = make_check_compiler_output
"check-bytecode-toplevel-output" ocaml
let check_ocamlnat_output = make_check_compiler_output
"check-native-toplevel-output" ocamlnat
let if_not_safe_string = {
action_name = "if_not_safe_string";
action_environment = env_id;
action_body = fun _log env ->
if Ocamltest_config.safe_string
then Skip "safe strings enabled"
else Pass env
}
Builtin_variables.test_pass, "0";
Builtin_variables.test_fail, "1";
Builtin_variables.test_skip, "125";
] env
let _ =
Environments.register_initializer
"test_exit_status_variables" initialize_test_exit_status_variables;
List.iter register
[
pass;
skip;
fail;
dumpenv;
unix;
windows;
compile_bytecode_with_bytecode_compiler;
compile_bytecode_with_native_compiler;
compile_native_with_bytecode_compiler;
compile_native_with_native_compiler;
execute;
setup_build_env;
run;
script;
check_program_output;
compare_bytecode_programs;
compare_native_programs;
check_ocamlc_dot_byte_output;
check_ocamlc_dot_opt_output;
check_ocamlopt_dot_byte_output;
check_ocamlopt_dot_opt_output;
run_in_ocaml;
run_in_ocamlnat;
check_ocaml_output;
check_ocamlnat_output;
if_not_safe_string;
]

28
ocamltest/builtin_actions.mli
View File

@ -19,32 +19,12 @@ val pass : Actions.t
val skip : Actions.t
val fail : Actions.t
val dumpenv : Actions.t
val unix : Actions.t
val windows : Actions.t
val compile_bytecode_with_bytecode_compiler : Actions.t
val compile_bytecode_with_native_compiler : Actions.t
val compile_native_with_bytecode_compiler : Actions.t
val compile_native_with_native_compiler : Actions.t
val execute : Actions.t
val expect : Actions.t
val run : Actions.t
val script : Actions.t
val check_program_output : Actions.t
val compare_bytecode_programs : Actions.t
val compare_native_programs : Actions.t
val check_ocamlc_dot_byte_output : Actions.t
val check_ocamlc_dot_opt_output : Actions.t
val check_ocamlopt_dot_byte_output : Actions.t
val check_ocamlopt_dot_opt_output : Actions.t
val run_in_ocaml : Actions.t
val run_in_ocamlnat : Actions.t
val check_ocaml_output : Actions.t
val check_ocamlnat_output : Actions.t
val if_not_safe_string : Actions.t

97
ocamltest/builtin_variables.ml
View File

@ -27,68 +27,17 @@ open Variables (* Should not be necessary with a ppx *)
let arguments = make ("arguments",
"Arguments passed to executed programs and scripts")
let c_preprocessor = make ("c_preprocessor",
"Command to use to invoke the C preprocessor")
let compiler_directory_suffix = make ("compiler_directory_suffix",
"Suffix to add to the directory where the test will be compiled")
let compiler_reference = make ("compiler_reference",
"Reference file for compiler output for ocamlc.byte and ocamlopt.byte")
let compiler_reference2 = make ("compiler_reference2",
"Reference file for compiler output for ocamlc.opt and ocamlopt.opt")
let compiler_reference_suffix = make ("compiler_reference_suffix",
"Suffix to add to the file name containing the reference for compiler output")
let compiler_output = make ("compiler_output",
"Where to log output of bytecode compilers")
let compiler_output2 = make ("compiler_output2",
"Where to log output of native compilers")
let ocamlc_flags = make ("ocamlc_flags",
"Flags passed to ocamlc.byte and ocamlc.opt")
let ocamlc_default_flags = make ("ocamlc_default_flags",
"Flags passed by default to ocamlc.byte and ocamlc.opt")
let files = make ("files",
"Files used by the tests")
let flags = make ("flags",
"Flags passed to all the compilers")
let ld_library_path = make ("ld_library_path",
"List of paths to lookup for loading dynamic libraries")
let libraries = make ("libraries",
"Libraries the program should be linked with")
let ocamltest_env = make ("ocamltest_env",
"File where hooks write their environment modifiers")
let modules = make ("modules",
"Other modules of the test")
let ocamlopt_flags = make ("ocamlopt_flags",
"Flags passed to ocamlopt.byte and ocamlopt.opt")
let ocamlopt_default_flags = make ("ocamlopt_default_flags",
"Flags passed by default to ocamlopt.byte and ocamlopt.opt")
let ocaml_byte_exit_status = make ("ocaml_byte_exit_status",
"Expected exit status of ocaml.byte")
let ocamlc_byte_exit_status = make ("ocamlc_byte_exit_status",
"Expected exit status of ocac.byte")
let ocamlopt_byte_exit_status = make ("ocamlopt_byte_exit_status",
"Expected exit status of ocamlopt.byte")
let ocaml_opt_exit_status = make ("ocaml_opt_exit_status",
"Expected exit status of ocaml.opt")
let ocamlc_opt_exit_status = make ("ocamlc_opt_exit_status",
"Expected exit status of ocac.opt")
let ocamlopt_opt_exit_status = make ("ocamlopt_opt_exit_status",
"Expected exit status of ocamlopt.opt")
let ocamltest_log = make ("ocamltest_log",
"Path to log file for the current test")
let output = make ("output",
"Where the output of executing the program is saved")
@ -111,15 +60,43 @@ let stderr = make ("stderr", "Default standard error")
let test_build_directory = make ("test_build_directory",
"Directory for files produced during a test")
let test_build_directory_prefix = make ("test_build_directory_prefix",
"Directory under which all test directories should be created")
let test_file = make ("test_file",
"Name of file containing the specification of which tests to run")
let test_source_directory = make ("test_source_directory",
"Directory containing the test source files")
let test_pass = make ("TEST_PASS",
"Exit code to let a script report success")
let test_skip = make ("TEST_SKIP",
"Exit code to let a script report skipping")
let test_fail = make ("TEST_FAIL",
"Exit code to let a script report failure")
let _ = List.iter register_variable
[
c_preprocessor;
ocamlc_default_flags;
ocamlopt_default_flags
arguments;
files;
ocamltest_env;
ocamltest_log;
output;
program; program2;
reference;
script;
stdin;
stdout;
stderr;
test_build_directory;
test_file;
test_source_directory;
test_pass;
test_skip;
test_fail;
]

45
ocamltest/builtin_variables.mli
View File

@ -19,45 +19,13 @@
val arguments : Variables.t
val c_preprocessor : Variables.t
val compiler_directory_suffix : Variables.t
val compiler_reference : Variables.t
val compiler_reference2 : Variables.t
val compiler_reference_suffix : Variables.t
val compiler_output : Variables.t
val compiler_output2 : Variables.t
val files : Variables.t
val flags : Variables.t
val ld_library_path : Variables.t
val libraries : Variables.t
val ocamltest_env : Variables.t
val modules : Variables.t
val ocamlc_flags : Variables.t
val ocamlc_default_flags : Variables.t
val ocamlopt_flags : Variables.t
val ocamlopt_default_flags : Variables.t
val ocaml_byte_exit_status : Variables.t
val ocamlc_byte_exit_status : Variables.t
val ocamlopt_byte_exit_status : Variables.t
val ocaml_opt_exit_status : Variables.t
val ocamlc_opt_exit_status : Variables.t
val ocamlopt_opt_exit_status : Variables.t
val ocamltest_log : Variables.t
val output : Variables.t
@ -73,7 +41,14 @@ val stdout : Variables.t
val stderr : Variables.t
val test_build_directory : Variables.t
val test_build_directory_prefix : Variables.t
val test_file : Variables.t
val test_source_directory : Variables.t
val test_pass : Variables.t
val test_skip : Variables.t
val test_fail : Variables.t

92
ocamltest/environments.ml
View File

@ -15,7 +15,7 @@
(* Definition of environments, used to pass parameters to tests and actions *)
exception Variable_already_defined of Variables.t
open Ocamltest_stdlib
module VariableMap = Map.Make (Variables)
@ -27,6 +27,19 @@ let to_bindings env =
let f variable value lst = (variable, value) :: lst in
VariableMap.fold f env []
let string_of_binding variable value =
let name = (Variables.name_of_variable variable) in
Printf.sprintf "%s=%s" name value
let to_system_env ?(f= string_of_binding) env =
let system_env = Array.make (VariableMap.cardinal env) "" in
let i = ref 0 in
let store variable value =
system_env.(!i) <- f variable value;
incr i in
VariableMap.iter store env;
system_env
let expand env value =
let bindings = to_bindings env in
@ -46,19 +59,15 @@ let safe_lookup variable env = match lookup variable env with
let is_variable_defined variable env =
VariableMap.mem variable env
let add variable value env =
if VariableMap.mem variable env
then raise (Variable_already_defined variable)
else VariableMap.add variable value env
let replace variable value environment =
VariableMap.add variable value environment
let add variable value env = VariableMap.add variable value env
let append variable appened_value environment =
let previous_value = safe_lookup variable environment in
let new_value = previous_value ^ appened_value in
VariableMap.add variable new_value environment
let remove = VariableMap.remove
let add_bindings bindings env =
let f env (variable, value) = add variable value env in
List.fold_left f env bindings
@ -69,15 +78,30 @@ let dump_assignment log (variable, value) =
Printf.fprintf log "%s = %s\n%!" (Variables.name_of_variable variable) value
let dump log environment =
List.iter (dump_assignment log) (VariableMap.bindings environment);
List.iter (dump_assignment log) (VariableMap.bindings environment)
(* Environment modifiers *)
(* Initializers *)
type env_initializer = out_channel -> t -> t
let (initializers : (string, env_initializer) Hashtbl.t) = Hashtbl.create 10
let register_initializer name code = Hashtbl.add initializers name code
let apply_initializer _log _name code env =
code _log env
let initialize log env =
let f = apply_initializer log in
Hashtbl.fold f initializers env
(* Modifiers *)
type modifier =
| Include of string
| Add of Variables.t * string
| Replace of Variables.t * string
| Append of Variables.t * string
| Remove of Variables.t
type modifiers = modifier list
@ -87,7 +111,7 @@ exception Modifiers_name_not_found of string
let (registered_modifiers : (string, modifiers) Hashtbl.t) = Hashtbl.create 20
let register modifiers name =
let register_modifiers name modifiers =
if name="" then raise Empty_modifiers_name
else if Hashtbl.mem registered_modifiers name
then raise (Modifiers_name_already_registered name)
@ -101,7 +125,49 @@ let rec apply_modifier environment = function
| Include modifiers_name ->
apply_modifiers environment (find_modifiers modifiers_name)
| Add (variable, value) -> add variable value environment
| Replace (variable, value) -> replace variable value environment
| Append (variable, value) -> append variable value environment
| Remove variable -> remove variable environment
and apply_modifiers environment modifiers =
List.fold_left apply_modifier environment modifiers
let modifier_of_string str =
let invalid_argument = (Invalid_argument "modifier_of_string") in
if str="" then raise invalid_argument else begin
let l = String.length str in
if str.[0] = '-' then begin
let variable_name = String.sub str 1 (l-1) in
match Variables.find_variable variable_name with
| None -> raise (Variables.No_such_variable variable_name)
| Some variable -> Remove variable
end else begin match String.index_opt str '=' with
| None -> raise invalid_argument
| Some pos_eq -> if pos_eq <= 0 then raise invalid_argument else
let (append, varname_length) =
(match String.index_opt str '+' with
| None -> (false, pos_eq)
| Some pos_plus ->
if pos_plus = pos_eq-1
then (true, pos_plus)
else raise invalid_argument) in
let variable_name = String.sub str 0 varname_length in
match Variables.find_variable variable_name with
| None -> raise (Variables.No_such_variable variable_name)
| Some variable ->
if pos_eq >= l-2 || str.[pos_eq+1]<>'"' || str.[l-1]<>'"'
then raise invalid_argument
else let value_length = l - pos_eq - 3 in
let value = String.sub str (pos_eq+2) value_length in
if append then Append (variable, value)
else Add (variable, value)
end
end
let modifiers_of_file filename =
let ic = open_in filename in
let rec modifiers_of_lines acc = match input_line_opt ic with
| None -> acc
| Some line ->
modifiers_of_lines ((modifier_of_string (String.trim line)) :: acc) in
let modifiers = modifiers_of_lines [] in
close_in ic;
List.rev modifiers

23
ocamltest/environments.mli
View File

@ -15,14 +15,15 @@
(* Definition of environments, used to pass parameters to tests and actions *)
exception Variable_already_defined of Variables.t
type t
val empty : t
val from_bindings : (Variables.t * string) list -> t
val to_bindings : t -> (Variables.t * string) list
val string_of_binding : Variables.t -> string -> string
val to_system_env :
?f : (Variables.t -> string -> string) -> t -> string array
val lookup : Variables.t -> t -> string option
val safe_lookup : Variables.t -> t -> string
@ -33,13 +34,21 @@ val add_bindings : (Variables.t * string) list -> t -> t
val dump : out_channel -> t -> unit
(* Environment modifiers *)
(* Initializers *)
type env_initializer = out_channel -> t -> t
val register_initializer : string -> env_initializer -> unit
val initialize : env_initializer
(* Modifiers *)
type modifier =
| Include of string
| Add of Variables.t * string
| Replace of Variables.t * string
| Append of Variables.t * string
| Remove of Variables.t
type modifiers = modifier list
@ -50,4 +59,8 @@ exception Empty_modifiers_name
exception Modifiers_name_already_registered of string
exception Modifiers_name_not_found of string
val register : modifiers -> string -> unit
val register_modifiers : string -> modifiers -> unit
val modifier_of_string : string -> modifier
val modifiers_of_file : string -> modifiers

6
ocamltest/filecompare.ml
View File

@ -15,6 +15,8 @@
(* File comparison tools *)
open Ocamltest_stdlib
type result =
| Same
| Different
@ -149,7 +151,7 @@ let check_file ?(tool = default_comparison_tool) files =
if Sys.file_exists files.reference_filename
then compare_files ~tool:tool files
else begin
if Testlib.file_is_empty files.output_filename
if Sys.file_is_empty files.output_filename
then Same
else Unexpected_output
end
@ -164,4 +166,4 @@ let diff files =
"> " ^ temporary_file
] in
if (Sys.command diff_commandline) = 2 then Pervasives.Error "diff"
else Ok (Testlib.string_of_file temporary_file)
else Ok (Sys.string_of_file temporary_file)

64
ocamltest/main.ml
View File

@ -15,6 +15,7 @@
(* Main program of the ocamltest test driver *)
open Ocamltest_stdlib
open Tsl_semantics
type behavior =
@ -78,23 +79,18 @@ and run_test_i log common_prefix path behavior i test_tree =
run_test log common_prefix new_path behavior test_tree
let get_test_source_directory test_dirname =
if not (Filename.is_relative test_dirname) then test_dirname
else let pwd = Sys.getcwd() in
Filename.concat pwd test_dirname
if (Filename.is_relative test_dirname) then begin
Sys.chdir test_dirname; Sys.getcwd()
end else test_dirname
let get_test_build_directory test_dirname =
let get_test_build_directory_prefix test_dirname =
let ocamltestdir_variable = "OCAMLTESTDIR" in
let root = try Sys.getenv ocamltestdir_variable with
| Not_found -> (Filename.concat (Sys.getcwd ()) "_ocamltest") in
if test_dirname = "." then root
else Filename.concat root test_dirname
let main () =
if !Options.testfile = "" then begin
print_usage();
exit 1
end;
let test_filename = !Options.testfile in
let test_file test_filename =
(* Printf.printf "# reading test file %s\n%!" test_filename; *)
let tsl_block = tsl_block_of_file_safe test_filename in
let (rootenv_statements, test_trees) = test_trees_of_tsl_block tsl_block in
@ -104,7 +100,11 @@ let main () =
let make_tree test = Node ([], test, [], []) in
List.map make_tree default_tests
| _ -> test_trees in
let actions = actions_in_tests (tests_in_trees test_trees) in
let used_tests = tests_in_trees test_trees in
let used_actions = actions_in_tests used_tests in
let action_names =
let f act names = StringSet.add (Actions.action_name act) names in
Actions.ActionSet.fold f used_actions StringSet.empty in
let test_dirname = Filename.dirname test_filename in
let test_basename = Filename.basename test_filename in
let test_prefix = Filename.chop_extension test_basename in
@ -112,32 +112,48 @@ let main () =
if test_dirname="." then test_prefix
else Filename.concat test_dirname test_prefix in
let test_source_directory = get_test_source_directory test_dirname in
let test_build_directory = get_test_build_directory test_directory in
let hookname_prefix = Filename.concat test_source_directory test_prefix in
let test_build_directory_prefix =
get_test_build_directory_prefix test_directory in
Sys.make_directory test_build_directory_prefix;
Sys.chdir test_build_directory_prefix;
let log =
if !Options.log_to_stderr then stderr else begin
let log_filename = test_prefix ^ ".log" in
open_out log_filename
end in
let install_hook name =
let hook_name = Filename.make_filename hookname_prefix name in
if Sys.file_exists hook_name then begin
let hook = Actions_helpers.run_hook hook_name in
Actions.set_hook name hook
end in
StringSet.iter install_hook action_names;
let reference_filename = Filename.concat
test_source_directory (test_prefix ^ ".reference") in
let initial_environment = Environments.from_bindings
[
Builtin_variables.c_preprocessor, Ocamltest_config.c_preprocessor;
Builtin_variables.ocamlc_default_flags,
Ocamltest_config.ocamlc_default_flags;
Builtin_variables.ocamlopt_default_flags,
Ocamltest_config.ocamlopt_default_flags;
Builtin_variables.test_file, test_basename;
Builtin_variables.reference, reference_filename;
Builtin_variables.test_source_directory, test_source_directory;
Builtin_variables.test_build_directory, test_build_directory;
Builtin_variables.test_build_directory_prefix, test_build_directory_prefix;
] in
let root_environment =
interprete_environment_statements initial_environment rootenv_statements in
let rootenv = Actions.update_environment root_environment actions in
Testlib.make_directory test_build_directory;
Sys.chdir test_build_directory;
let log_filename = test_prefix ^ ".log" in
let log = open_out log_filename in
let rootenv = Environments.initialize log root_environment in
let common_prefix = " ... testing '" ^ test_basename ^ "' with" in
List.iteri
(run_test_i log common_prefix "" (Run rootenv))
test_trees;
close_out log
Actions.clear_all_hooks();
if not !Options.log_to_stderr then close_out log
let main () =
if !Options.files_to_test = [] then begin
print_usage();
exit 1
end;
List.iter test_file !Options.files_to_test
let _ = main()

657
ocamltest/ocaml_actions.ml Normal file
View File

@ -0,0 +1,657 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2017 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Actions specific to the OCaml compilers *)
open Ocamltest_stdlib
open Actions
(* Compilers and flags *)
let ocamlsrcdir () =
try Sys.getenv "OCAMLSRCDIR"
with Not_found -> Ocamltest_config.ocamlsrcdir
type runtime_variant =
| Normal
| Debug
| Instrumented
let runtime_variant() =
let use_runtime = try Sys.getenv "USE_RUNTIME" with Not_found -> "" in
if use_runtime="d" then Debug
else if use_runtime="i" then Instrumented
else Normal
let ocamlrun ocamlsrcdir =
let runtime = match runtime_variant () with
| Normal -> "ocamlrun"
| Debug -> "ocamlrund"
| Instrumented -> "ocamlruni" in
let ocamlrunfile = Filename.mkexe runtime in
Filename.make_path [ocamlsrcdir; "byterun"; ocamlrunfile]
let ocamlc ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "ocamlc"]
let ocaml ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "ocaml"]
let ocamlc_dot_byte ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let ocamlc = ocamlc ocamlsrcdir in
ocamlrun ^ " " ^ ocamlc
let ocamlc_dot_opt ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "ocamlc.opt"]
let ocamlopt ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "ocamlopt"]
let ocamlopt_dot_byte ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let ocamlopt = ocamlopt ocamlsrcdir in
ocamlrun ^ " " ^ ocamlopt
let ocamlopt_dot_opt ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "ocamlopt.opt"]
let ocaml_dot_byte ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let ocaml = ocaml ocamlsrcdir in
ocamlrun ^ " " ^ ocaml
let ocaml_dot_opt ocamlsrcdir =
Filename.make_path [ocamlsrcdir; Filename.mkexe "ocamlnat"]
let cmpbyt ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "tools"; "cmpbyt"]
let stdlib ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "stdlib"]
let stdlib_flags ocamlsrcdir =
let stdlib_path = stdlib ocamlsrcdir in
"-nostdlib -I " ^ stdlib_path
let c_includes ocamlsrcdir =
Filename.make_path [ocamlsrcdir; "byterun"]
let c_includes_flags ocamlsrcdir =
let dir = c_includes ocamlsrcdir in
"-ccopt -I" ^ dir
let use_runtime backend ocamlsrcdir = match backend with
| Sys.Bytecode ->
let ocamlrun = ocamlrun ocamlsrcdir in
"-use-runtime " ^ ocamlrun
| _ -> ""
let runtime_variant_flags backend ocamlsrcdir =
let variant = runtime_variant() in
if variant=Normal then ""
else begin
let variant_str = if variant=Debug then "d" else "i" in
let backend_lib = match backend with
| Sys.Bytecode -> "byterun"
| Sys.Native -> "asmrun"
| Sys.Other _ -> "stdlib" in
let backend_lib_dir = Filename.make_path [ocamlsrcdir; backend_lib] in
("-runtime-variant " ^ variant_str ^" -I " ^ backend_lib_dir)
end
(* Compiler descriptions *)
type compiler_description = {
compiler_name : string -> string;
compiler_flags : string;
compiler_directory : string;
compiler_backend : Sys.backend_type;
compiler_exit_status_variabe : Variables.t;
compiler_reference_variable : Variables.t;
compiler_output_variable : Variables.t
}
(* Compilers compiling byte-code programs *)
let ocamlc_byte_compiler =
{
compiler_name = ocamlc_dot_byte;
compiler_flags = "";
compiler_directory = "ocamlc.byte";
compiler_backend = Sys.Bytecode;
compiler_exit_status_variabe = Ocaml_variables.ocamlc_byte_exit_status;
compiler_reference_variable = Ocaml_variables.compiler_reference;
compiler_output_variable = Ocaml_variables.compiler_output;
}
let ocamlc_opt_compiler =
{
compiler_name = ocamlc_dot_opt;
compiler_flags = "";
compiler_directory = "ocamlc.opt";
compiler_backend = Sys.Bytecode;
compiler_exit_status_variabe = Ocaml_variables.ocamlc_opt_exit_status;
compiler_reference_variable = Ocaml_variables.compiler_reference2;
compiler_output_variable = Ocaml_variables.compiler_output2;
}
(* Compilers compiling native-code programs *)
let ocamlopt_byte_compiler =
{
compiler_name = ocamlopt_dot_byte;
compiler_flags = "";
compiler_directory = "ocamlopt.byte";
compiler_backend = Sys.Native;
compiler_exit_status_variabe = Ocaml_variables.ocamlopt_byte_exit_status;
compiler_reference_variable = Ocaml_variables.compiler_reference;
compiler_output_variable = Ocaml_variables.compiler_output;
}
let ocamlopt_opt_compiler =
{
compiler_name = ocamlopt_dot_opt;
compiler_flags = "";
compiler_directory = "ocamlopt.opt";
compiler_backend = Sys.Native;
compiler_exit_status_variabe = Ocaml_variables.ocamlopt_opt_exit_status;
compiler_reference_variable = Ocaml_variables.compiler_reference2;
compiler_output_variable = Ocaml_variables.compiler_output2;
}
(* Top-levels *)
let ocaml_compiler = {
compiler_name = ocaml_dot_byte;
compiler_flags = "";
compiler_directory = "ocaml";
compiler_backend = Sys.Bytecode;
compiler_exit_status_variabe = Ocaml_variables.ocaml_exit_status;
compiler_reference_variable = Ocaml_variables.compiler_reference;
compiler_output_variable = Ocaml_variables.compiler_output;
}
let ocamlnat_compiler = {
compiler_name = ocaml_dot_opt;
compiler_flags = "-S"; (* Keep intermediate assembly files *)
compiler_directory = "ocamlnat";
compiler_backend = Sys.Native;
compiler_exit_status_variabe = Ocaml_variables.ocamlnat_exit_status;
compiler_reference_variable = Ocaml_variables.compiler_reference2;
compiler_output_variable = Ocaml_variables.compiler_output2;
}
let expected_compiler_exit_status env compiler =
try int_of_string
(Environments.safe_lookup compiler.compiler_exit_status_variabe env)
with _ -> 0
let compiler_reference_filename env prefix compiler =
let compiler_reference_suffix =
Environments.safe_lookup Ocaml_variables.compiler_reference_suffix env in
let suffix =
if compiler_reference_suffix<>""
then compiler_reference_suffix ^ ".reference"
else ".reference" in
let mk s = (Filename.make_filename prefix s) ^ suffix in
let filename = mk compiler.compiler_directory in
if Sys.file_exists filename then filename else
let filename = mk
(Ocaml_backends.string_of_backend compiler.compiler_backend) in
if Sys.file_exists filename then filename else
mk "compilers"
(* Extracting information from environment *)
let get_backend_value_from_env env bytecode_var native_var =
Ocaml_backends.make_backend_function
(Environments.safe_lookup bytecode_var env)
(Environments.safe_lookup native_var env)
let modules env =
Actions_helpers.words_of_variable env Ocaml_variables.modules
let directories env =
Actions_helpers.words_of_variable env Ocaml_variables.directories
let directory_flags env =
let f dir = ("-I " ^ dir) in
let l = List.map f (directories env) in
String.concat " " l
let flags env = Environments.safe_lookup Ocaml_variables.flags env
let libraries backend env =
let value = Environments.safe_lookup Ocaml_variables.libraries env in
let libs = String.words value in
let extension = Ocaml_backends.library_extension backend in
let add_extension lib = Filename.make_filename lib extension in
String.concat " " (List.map add_extension libs)
let backend_default_flags env =
get_backend_value_from_env env
Ocaml_variables.ocamlc_default_flags
Ocaml_variables.ocamlopt_default_flags
let backend_flags env =
get_backend_value_from_env env
Ocaml_variables.ocamlc_flags
Ocaml_variables.ocamlopt_flags
let link_modules
ocamlsrcdir compiler compilername compileroutput program_variable
custom c_headers_flags log env modules
=
let backend = compiler.compiler_backend in
let expected_exit_status = expected_compiler_exit_status env compiler in
let executable_name = match Environments.lookup program_variable env with
| None -> assert false
| Some program -> program in
let module_names =
String.concat " " (List.map Filetype.make_filename modules) in
let what = Printf.sprintf "Linking modules %s into %s"
module_names executable_name in
Printf.fprintf log "%s\n%!" what;
let output = "-o " ^ executable_name in
let customstr = if custom then "-custom" else "" in
let commandline =
[
compilername;
customstr;
c_headers_flags;
use_runtime backend ocamlsrcdir;
runtime_variant_flags backend ocamlsrcdir;
stdlib_flags ocamlsrcdir;
"-linkall";
directory_flags env;
flags env;
libraries backend env;
backend_default_flags env backend;
backend_flags env backend;
output;
module_names
] in
let exit_status =
Actions_helpers.run_cmd
~stdout_variable:compileroutput
~stderr_variable:compileroutput
~append:true
log env commandline in
if exit_status=expected_exit_status
then Pass env
else Fail (Actions_helpers.mkreason
what (String.concat " " commandline) exit_status)
let compile_program
ocamlsrcdir compiler compilername compileroutput program_variable
log env modules
=
let is_c_file (_filename, filetype) = filetype=Filetype.C in
let has_c_file = List.exists is_c_file modules in
let backend = compiler.compiler_backend in
let custom = (backend = Sys.Bytecode) && has_c_file in
let c_headers_flags =
if has_c_file then c_includes_flags ocamlsrcdir else "" in
link_modules
ocamlsrcdir compiler compilername compileroutput
program_variable custom c_headers_flags log env modules
let module_has_interface directory module_name =
let interface_name =
Filetype.make_filename (module_name, Filetype.Interface) in
let interface_fullpath = Filename.make_path [directory;interface_name] in
Sys.file_exists interface_fullpath
let add_module_interface directory module_description =
match module_description with
| (filename, Filetype.Implementation) when
module_has_interface directory filename ->
[(filename, Filetype.Interface); module_description]
| _ -> [module_description]
let print_module_names log description modules =
Printf.fprintf log "%s modules: %s\n%!"
description
(String.concat " " (List.map Filetype.make_filename modules))
let find_source_modules log env =
let source_directory = Actions_helpers.test_source_directory env in
let specified_modules =
List.map Filetype.filetype
((modules env) @ [(Actions_helpers.testfile env)]) in
print_module_names log "Specified" specified_modules;
let source_modules =
List.concatmap
(add_module_interface source_directory)
specified_modules in
print_module_names log "Source" source_modules;
Environments.add
Ocaml_variables.source_modules
(String.concat " " (List.map Filetype.make_filename source_modules))
env
let setup_compiler_build_env compiler log env =
let source_modules =
Actions_helpers.words_of_variable env Ocaml_variables.source_modules in
let compiler_directory_suffix =
Environments.safe_lookup Ocaml_variables.compiler_directory_suffix env in
let compiler_directory_name =
compiler.compiler_directory ^ compiler_directory_suffix in
let build_dir = Filename.concat
(Environments.safe_lookup
Builtin_variables.test_build_directory_prefix env)
compiler_directory_name in
let newenv =
Environments.add Builtin_variables.test_build_directory build_dir env in
Actions_helpers.setup_build_env false source_modules log newenv
let mk_compiler_env_setup name compiler =
Actions.make name (setup_compiler_build_env compiler)
let setup_ocamlc_byte_build_env =
mk_compiler_env_setup "setup-ocamlc.byte-build-env" ocamlc_byte_compiler
let setup_ocamlc_opt_build_env =
mk_compiler_env_setup "setup-ocamlc.opt-build-env" ocamlc_opt_compiler
let setup_ocamlopt_byte_build_env =
mk_compiler_env_setup "setup-ocamlopt.byte-build-env" ocamlopt_byte_compiler
let setup_ocamlopt_opt_build_env =
mk_compiler_env_setup "setup-ocamlopt.opt-build-env" ocamlopt_opt_compiler
let setup_ocaml_build_env =
mk_compiler_env_setup "setup-ocaml-build-env" ocaml_compiler
let setup_ocamlnat_build_env =
mk_compiler_env_setup "setup-ocamlnat-build-env" ocamlnat_compiler
let prepare_module (module_name, module_type) =
match module_type with
| Filetype.Implementation | Filetype.Interface | Filetype.C ->
[(module_name, module_type)]
| Filetype.C_minus_minus -> assert false
| Filetype.Lexer -> assert false
| Filetype.Grammar -> assert false
let compile_test_program program_variable compiler log env =
let backend = compiler.compiler_backend in
let testfile = Actions_helpers.testfile env in
let testfile_basename = Filename.chop_extension testfile in
let source_directory = Actions_helpers.test_source_directory env in
let build_directory =
Actions_helpers.test_build_directory env in
let compilerreference_prefix =
Filename.make_path [source_directory; testfile_basename] in
let compilerreference_filename =
compiler_reference_filename env compilerreference_prefix compiler in
let compiler_reference_variable = compiler.compiler_reference_variable in
let executable_filename =
Filename.mkexe
(Filename.make_filename
testfile_basename (Ocaml_backends.executable_extension backend)) in
let executable_path =
Filename.make_path [build_directory; executable_filename] in
let compiler_output_filename =
Filename.make_filename compiler.compiler_directory "output" in
let compiler_output =
Filename.make_path [build_directory; compiler_output_filename] in
let compiler_output_variable = compiler.compiler_output_variable in
let newenv = Environments.add_bindings
[
(program_variable, executable_path);
(compiler_reference_variable, compilerreference_filename);
(compiler_output_variable, compiler_output);
] env in
if Sys.file_exists compiler_output_filename then
Sys.remove compiler_output_filename;
let ocamlsrcdir = ocamlsrcdir () in
let compilername = compiler.compiler_name ocamlsrcdir in
let source_modules =
Actions_helpers.words_of_variable env Ocaml_variables.source_modules in
let prepared_modules =
List.concatmap prepare_module
(List.map Filetype.filetype source_modules) in
compile_program
ocamlsrcdir
compiler
compilername
compiler_output_variable
program_variable log newenv prepared_modules
(* Compile actions *)
let ocamlc_byte = Actions.make
"ocamlc.byte"
(compile_test_program Builtin_variables.program ocamlc_byte_compiler)
let ocamlc_opt = Actions.make
"ocamlc.opt"
(compile_test_program Builtin_variables.program2 ocamlc_opt_compiler)
let ocamlopt_byte = Actions.make
"ocamlopt.byte"
(compile_test_program Builtin_variables.program ocamlopt_byte_compiler)
let ocamlopt_opt = Actions.make
"ocamlopt.opt"
(compile_test_program Builtin_variables.program2 ocamlopt_opt_compiler)
let run_expect log env =
let newenv = Environments.apply_modifiers env Ocaml_modifiers.expect in
Actions_helpers.run_script log newenv
let expect = Actions.make "expect" run_expect
let make_check_compiler_output name compiler = Actions.make
name
(Actions_helpers.check_output
"compiler"
compiler.compiler_output_variable
compiler.compiler_reference_variable)
let check_ocamlc_byte_output = make_check_compiler_output
"check-ocamlc.byte-output" ocamlc_byte_compiler
let check_ocamlc_opt_output = make_check_compiler_output
"check-ocamlc.opt-output" ocamlc_opt_compiler
let check_ocamlopt_byte_output = make_check_compiler_output
"check-ocamlopt.byte-output" ocamlopt_byte_compiler
let check_ocamlopt_opt_output = make_check_compiler_output
"check-ocamlopt.opt-output" ocamlopt_opt_compiler
let really_compare_programs backend comparison_tool log env =
let program = Environments.safe_lookup Builtin_variables.program env in
let program2 = Environments.safe_lookup Builtin_variables.program2 env in
let what = Printf.sprintf "Comparing %s programs %s and %s"
(Ocaml_backends.string_of_backend backend) program program2 in
Printf.fprintf log "%s\n%!" what;
let files = {
Filecompare.filetype = Filecompare.Binary;
Filecompare.reference_filename = program;
Filecompare.output_filename = program2
} in
if Ocamltest_config.flambda && backend = Sys.Native
then begin
Printf.fprintf log
"flambda temporarily disables comparison of native programs";
Pass env
end else
if backend = Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
then begin
Printf.fprintf log
"comparison of native programs temporarily disabled under Windows";
Pass env
end else begin
let comparison_tool =
if backend=Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
then
let bytes_to_ignore = 512 (* comparison_start_address program *) in
Filecompare.make_cmp_tool bytes_to_ignore
else comparison_tool in
match Filecompare.compare_files ~tool:comparison_tool files with
| Filecompare.Same -> Pass env
| Filecompare.Different ->
let reason = Printf.sprintf "Files %s and %s are different"
program program2 in
Fail reason
| Filecompare.Unexpected_output -> assert false
| Filecompare.Error (commandline, exitcode) ->
let reason = Actions_helpers.mkreason what commandline exitcode in
Fail reason
end
let compare_programs backend comparison_tool log env =
let compare_programs =
Environments.safe_lookup Ocaml_variables.compare_programs env in
if compare_programs = "false" then begin
Printf.fprintf log "Skipping program comparison (disabled)";
Pass env
end else really_compare_programs backend comparison_tool log env
let make_bytecode_programs_comparison_tool ocamlsrcdir =
let ocamlrun = ocamlrun ocamlsrcdir in
let cmpbyt = cmpbyt ocamlsrcdir in
let tool_name = ocamlrun ^ " " ^ cmpbyt in
Filecompare.make_comparison_tool tool_name ""
let native_programs_comparison_tool = Filecompare.default_comparison_tool
let compare_bytecode_programs_code log env =
let ocamlsrcdir = ocamlsrcdir () in
let bytecode_programs_comparison_tool =
make_bytecode_programs_comparison_tool ocamlsrcdir in
compare_programs Sys.Bytecode bytecode_programs_comparison_tool log env
let compare_bytecode_programs = Actions.make
"compare-bytecode-programs"
compare_bytecode_programs_code
let compare_native_programs = Actions.make
"compare-native-programs"
(compare_programs Sys.Native native_programs_comparison_tool)
let run_test_program_in_toplevel toplevel log env =
let testfile = Actions_helpers.testfile env in
let testfile_basename = Filename.chop_extension testfile in
let expected_exit_status = expected_compiler_exit_status env toplevel in
let what =
Printf.sprintf "Running %s in %s toplevel (expected exit status: %d)"
testfile
(Ocaml_backends.string_of_backend toplevel.compiler_backend)
expected_exit_status in
Printf.fprintf log "%s\n%!" what;
let source_directory = Actions_helpers.test_source_directory env in
let compiler_directory_suffix =
Environments.safe_lookup Ocaml_variables.compiler_directory_suffix env in
let compiler_directory_name =
toplevel.compiler_directory ^ compiler_directory_suffix in
let build_directory = Filename.make_path
[Actions_helpers.test_build_directory env; compiler_directory_name] in
let compilerreference_prefix =
Filename.make_path [source_directory; testfile_basename] in
let compilerreference_filename =
compiler_reference_filename env compilerreference_prefix toplevel in
let compiler_reference_variable = toplevel.compiler_reference_variable in
let compiler_output_filename =
Filename.make_filename toplevel.compiler_directory "output" in
let compiler_output =
Filename.make_path [build_directory; compiler_output_filename] in
let compiler_output_variable = toplevel.compiler_output_variable in
let newenv = Environments.add_bindings
[
(compiler_reference_variable, compilerreference_filename);
(compiler_output_variable, compiler_output);
] env in
if Sys.file_exists compiler_output_filename then
Sys.remove compiler_output_filename;
let ocamlsrcdir = ocamlsrcdir () in
let toplevel_name = toplevel.compiler_name ocamlsrcdir in
let toplevel_default_flags = "-noinit -no-version -noprompt" in
let commandline =
[
toplevel_name;
toplevel_default_flags;
toplevel.compiler_flags;
stdlib_flags ocamlsrcdir;
directory_flags env;
flags env;
] in
let exit_status =
Actions_helpers.run_cmd
~stdin_variable:Builtin_variables.test_file
~stdout_variable:compiler_output_variable
~stderr_variable:compiler_output_variable
log newenv commandline in
if exit_status=expected_exit_status
then Pass newenv
else Fail (Actions_helpers.mkreason
what (String.concat " " commandline) exit_status)
let ocaml = Actions.make
"ocaml"
(run_test_program_in_toplevel ocaml_compiler)
let ocamlnat = Actions.make
"ocamlnat"
(run_test_program_in_toplevel ocamlnat_compiler)
let check_ocaml_output = make_check_compiler_output
"check-ocaml-output" ocaml_compiler
let check_ocamlnat_output = make_check_compiler_output
"check-ocamlnat-output" ocamlnat_compiler
let config_variables _log env = Environments.add_bindings
[
Ocaml_variables.c_preprocessor, Ocamltest_config.c_preprocessor;
Ocaml_variables.ocamlc_default_flags,
Ocamltest_config.ocamlc_default_flags;
Ocaml_variables.ocamlopt_default_flags,
Ocamltest_config.ocamlopt_default_flags;
Ocaml_variables.ocamlsrcdir, ocamlsrcdir();
Ocaml_variables.os_type, Sys.os_type;
] env
let _ =
Environments.register_initializer "find_source_modules" find_source_modules;
Environments.register_initializer "config_variables" config_variables;
List.iter register
[
setup_ocamlc_byte_build_env;
ocamlc_byte;
check_ocamlc_byte_output;
setup_ocamlc_opt_build_env;
ocamlc_opt;
check_ocamlc_opt_output;
setup_ocamlopt_byte_build_env;
ocamlopt_byte;
check_ocamlopt_byte_output;
setup_ocamlopt_opt_build_env;
ocamlopt_opt;
check_ocamlopt_opt_output;
expect;
compare_bytecode_programs;
compare_native_programs;
setup_ocaml_build_env;
ocaml;
check_ocaml_output;
setup_ocamlnat_build_env;
ocamlnat;
check_ocamlnat_output;
]

52
ocamltest/builtin_modifiers.ml → ocamltest/ocaml_actions.mli
View File

@ -4,7 +4,7 @@
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* Copyright 2017 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
@ -13,32 +13,26 @@
(* *)
(**************************************************************************)
(* Definition of a few built-in environment modifiers *)
(* Actions specific to the OCaml compilers *)
open Environments
open Builtin_variables
let expect =
[
Replace (script, "bash ${OCAMLSRCDIR}/testsuite/tools/expect");
]
let principal =
[
Append (flags, " -principal ");
Add (compiler_directory_suffix, ".principal");
Add (compiler_reference_suffix, ".principal");
]
let testinglib_directory = Ocamltest_config.ocamlsrcdir ^ "/testsuite/lib"
let testing =
[
Append (flags, (" -I " ^ testinglib_directory ^ " "));
Append (libraries, " testing ");
]
let _ =
register expect "expect";
register principal "principal";
register testing "testing"
val setup_ocamlc_byte_build_env : Actions.t
val ocamlc_byte : Actions.t
val check_ocamlc_byte_output : Actions.t
val setup_ocamlc_opt_build_env : Actions.t
val ocamlc_opt : Actions.t
val check_ocamlc_opt_output : Actions.t
val setup_ocamlopt_byte_build_env : Actions.t
val ocamlopt_byte : Actions.t
val check_ocamlopt_byte_output : Actions.t
val setup_ocamlopt_opt_build_env : Actions.t
val ocamlopt_opt : Actions.t
val check_ocamlopt_opt_output : Actions.t
val expect : Actions.t
val compare_bytecode_programs : Actions.t
val compare_native_programs : Actions.t
val setup_ocaml_build_env : Actions.t
val ocaml : Actions.t
val check_ocaml_output : Actions.t
val setup_ocamlnat_build_env : Actions.t
val ocamlnat : Actions.t
val check_ocamlnat_output : Actions.t

2
ocamltest/backends.ml → ocamltest/ocaml_backends.ml
View File

@ -15,6 +15,8 @@
(* Backends of the OCaml compiler and their properties *)
open Ocamltest_stdlib
type t = Sys.backend_type
let string_of_backend = function

2
ocamltest/backends.mli → ocamltest/ocaml_backends.mli
View File

@ -15,6 +15,8 @@
(* Backends of the OCaml compiler and their properties *)
open Ocamltest_stdlib
type t = Sys.backend_type
val string_of_backend : t -> string

62
ocamltest/ocaml_modifiers.ml Normal file
View File

@ -0,0 +1,62 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Definition of a few OCaml-specific environment modifiers *)
open Ocamltest_stdlib
open Environments
let expect =
[
Add (Builtin_variables.script,
"bash ${OCAMLSRCDIR}/testsuite/tools/expect");
]
let principal =
[
Append (Ocaml_variables.flags, " -principal ");
Add (Ocaml_variables.compiler_directory_suffix, ".principal");
Add (Ocaml_variables.compiler_reference_suffix, ".principal");
]
let wrap str = (" " ^ str ^ " ")
let make_library_modifier library directory =
[
Append (Ocaml_variables.directories, (wrap directory));
Append (Ocaml_variables.libraries, (wrap library));
Append (Builtin_variables.ld_library_path, (wrap directory));
]
let compiler_subdir subdir =
Filename.make_path (Ocamltest_config.ocamlsrcdir :: subdir)
let testing = make_library_modifier
"testing" (compiler_subdir ["testsuite"; "lib"])
let unixlibdir = if Sys.os_type="Win32" then "win32unix" else "unix"
let unix = make_library_modifier
"unix" (compiler_subdir ["otherlibs"; unixlibdir])
let str = make_library_modifier
"str" (compiler_subdir ["otherlibs"; "str"])
let _ =
register_modifiers "expect" expect;
register_modifiers "principal" principal;
register_modifiers "testing" testing;
register_modifiers "unix" unix;
register_modifiers "str" str

6
ocamltest/builtin_modifiers.mli → ocamltest/ocaml_modifiers.mli
View File

@ -13,10 +13,14 @@
(* *)
(**************************************************************************)
(* Definition of a few built-in environment modifiers *)
(* Definition of a few OCaml-specific environment modifiers *)
val expect : Environments.modifiers
val principal : Environments.modifiers
val testing : Environments.modifiers
val unix : Environments.modifiers
val str : Environments.modifiers

35
ocamltest/builtin_tests.ml → ocamltest/ocaml_tests.ml
View File

@ -13,16 +13,18 @@
(* *)
(**************************************************************************)
(* Definitions of built-in tests *)
(* Tests specific to the OCaml compiler *)
open Tests
open Builtin_actions
open Ocaml_actions
let bytecode =
let opt_actions =
[
compile_bytecode_with_native_compiler;
check_ocamlc_dot_opt_output;
setup_ocamlc_opt_build_env;
ocamlc_opt;
check_ocamlc_opt_output;
compare_bytecode_programs
] in
{
@ -30,10 +32,11 @@ let bytecode =
test_run_by_default = true;
test_actions =
[
compile_bytecode_with_bytecode_compiler;
check_ocamlc_dot_byte_output;
execute;
check_program_output
setup_ocamlc_byte_build_env;
ocamlc_byte;
check_ocamlc_byte_output;
run;
check_program_output;
] @ (if Ocamltest_config.arch<>"none" then opt_actions else [])
}
@ -42,12 +45,14 @@ let native = {
test_run_by_default = true;
test_actions =
[
compile_native_with_bytecode_compiler;
check_ocamlopt_dot_byte_output;
execute;
setup_ocamlopt_byte_build_env;
ocamlopt_byte;
check_ocamlopt_byte_output;
run;
check_program_output;
compile_native_with_native_compiler;
check_ocamlopt_dot_opt_output;
setup_ocamlopt_opt_build_env;
ocamlopt_opt;
check_ocamlopt_opt_output;
compare_native_programs;
]
}
@ -57,10 +62,12 @@ let toplevel = {
test_run_by_default = false;
test_actions =
[
run_in_ocaml;
setup_ocaml_build_env;
ocaml;
check_ocaml_output;
(*
run_in_ocamlnat;
setup_ocamlnat_build_env;
ocamlnat;
check_ocamlnat_output;
*)
]

2
ocamltest/builtin_tests.mli → ocamltest/ocaml_tests.mli
View File

@ -13,7 +13,7 @@
(* *)
(**************************************************************************)
(* Definitions of built-in tests *)
(* Tests specific to the OCaml compiler *)
val bytecode : Tests.t

127
ocamltest/ocaml_variables.ml Normal file
View File

@ -0,0 +1,127 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Definition of variables used by built-in actions *)
(* The variables are listed in alphabetical order *)
(*
The name of the identifier representing a variable and its string name
should be similar. Is there a way to enforce this?
*)
open Variables (* Should not be necessary with a ppx *)
let c_preprocessor = make ("c_preprocessor",
"Command to use to invoke the C preprocessor")
let compare_programs = make ("compare_programs",
"Set to \"false\" to disable program comparison")
let compiler_directory_suffix = make ("compiler_directory_suffix",
"Suffix to add to the directory where the test will be compiled")
let compiler_reference = make ("compiler_reference",
"Reference file for compiler output for ocamlc.byte and ocamlopt.byte")
let compiler_reference2 = make ("compiler_reference2",
"Reference file for compiler output for ocamlc.opt and ocamlopt.opt")
let compiler_reference_suffix = make ("compiler_reference_suffix",
"Suffix to add to the file name containing the reference for compiler output")
let compiler_output = make ("compiler_output",
"Where to log output of bytecode compilers")
let compiler_output2 = make ("compiler_output2",
"Where to log output of native compilers")
let ocamlc_flags = make ("ocamlc_flags",
"Flags passed to ocamlc.byte and ocamlc.opt")
let ocamlc_default_flags = make ("ocamlc_default_flags",
"Flags passed by default to ocamlc.byte and ocamlc.opt")
let directories = make ("directories",
"Directories to include by all the compilers")
let flags = make ("flags",
"Flags passed to all the compilers")
let libraries = make ("libraries",
"Libraries the program should be linked with")
let modules = make ("modules",
"Other modules of the test")
let ocamlopt_flags = make ("ocamlopt_flags",
"Flags passed to ocamlopt.byte and ocamlopt.opt")
let ocamlopt_default_flags = make ("ocamlopt_default_flags",
"Flags passed by default to ocamlopt.byte and ocamlopt.opt")
let ocaml_exit_status = make ("ocaml_exit_status",
"Expected exit status of ocaml")
let ocamlc_byte_exit_status = make ("ocamlc_byte_exit_status",
"Expected exit status of ocac.byte")
let ocamlopt_byte_exit_status = make ("ocamlopt_byte_exit_status",
"Expected exit status of ocamlopt.byte")
let ocamlnat_exit_status = make ("ocamlnat_exit_status",
"Expected exit status of ocamlnat")
let ocamlc_opt_exit_status = make ("ocamlc_opt_exit_status",
"Expected exit status of ocac.opt")
let ocamlopt_opt_exit_status = make ("ocamlopt_opt_exit_status",
"Expected exit status of ocamlopt.opt")
let ocamlsrcdir = make ("ocamlsrcdir",
"Where OCaml sources are")
let os_type = make ("os_type",
"The OS we are running on")
let source_modules = make ("source_modules",
"Complete list of modules (private)")
let _ = List.iter register_variable
[
c_preprocessor;
compiler_directory_suffix;
compiler_reference;
compiler_reference2;
compiler_reference_suffix;
compiler_output;
compiler_output2;
directories;
flags;
libraries;
modules;
ocamlc_flags;
ocamlc_default_flags;
ocamlopt_flags;
ocamlopt_default_flags;
ocaml_exit_status;
ocamlc_byte_exit_status;
ocamlopt_byte_exit_status;
ocamlnat_exit_status;
ocamlc_opt_exit_status;
ocamlopt_opt_exit_status;
os_type;
(* source_modules is intentionally not registered *)
]

66
ocamltest/ocaml_variables.mli Normal file
View File

@ -0,0 +1,66 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Definition of OCaml-specific variables *)
(* The variables are listed in alphabetical order *)
val c_preprocessor : Variables.t
val compare_programs : Variables.t
val compiler_directory_suffix : Variables.t
val compiler_reference : Variables.t
val compiler_reference2 : Variables.t
val compiler_reference_suffix : Variables.t
val compiler_output : Variables.t
val compiler_output2 : Variables.t
val directories : Variables.t
val flags : Variables.t
val libraries : Variables.t
val modules : Variables.t
val ocamlc_flags : Variables.t
val ocamlc_default_flags : Variables.t
val ocamlopt_flags : Variables.t
val ocamlopt_default_flags : Variables.t
val ocaml_exit_status : Variables.t
val ocamlc_byte_exit_status : Variables.t
val ocamlopt_byte_exit_status : Variables.t
val ocamlnat_exit_status : Variables.t
val ocamlc_opt_exit_status : Variables.t
val ocamlopt_opt_exit_status : Variables.t
val ocamlsrcdir : Variables.t
val os_type : Variables.t
val source_modules : Variables.t

164
ocamltest/ocamltest_stdlib.ml Normal file
View File

@ -0,0 +1,164 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* A few extensions to OCaml's standard library *)
(* Pervaisive *)
let input_line_opt ic =
try Some (input_line ic) with End_of_file -> None
module Char = struct
include Char
let is_blank c =
c = ' ' || c = '\012' || c = '\n' || c = '\r' || c = '\t'
end
module Filename = struct
include Filename
let path_sep = if Sys.os_type="Win32" then ";" else ":"
(* This function comes from otherlibs/win32unix/unix.ml *)
let maybe_quote f =
if String.contains f ' ' ||
String.contains f '\"' ||
String.contains f '\t' ||
f = ""
then Filename.quote f
else f
let make_filename name ext = String.concat "." [name; ext]
let make_path components = List.fold_left Filename.concat "" components
let mkexe =
if Sys.os_type="Win32"
then fun name -> make_filename name "exe"
else fun name -> name
end
module List = struct
include List
let rec concatmap f = function
| [] -> []
| x::xs -> (f x) @ (concatmap f xs)
end
module String = struct
include String
let string_of_char = String.make 1
let words s =
let l = String.length s in
let rec f quote w ws i =
if i>=l then begin
if w<>"" then List.rev (w::ws)
else List.rev ws
end else begin
let j = i+1 in
match s.[i] with
| '\'' -> f (not quote) w ws j
| ' ' ->
begin
if quote
then f true (w ^ (string_of_char ' ')) ws j
else begin
if w=""
then f false w ws j
else f false "" (w::ws) j
end
end
| _ as c -> f quote (w ^ (string_of_char c)) ws j
end in
if l=0 then [] else f false "" [] 0
end
module Sys = struct
include Sys
let file_is_empty filename =
let ic = open_in filename in
let filesize = in_channel_length ic in
close_in ic;
filesize = 0
let run_system_command command = match Sys.command command with
| 0 -> ()
| _ as exitcode ->
Printf.eprintf "Sysem command %s failed with status %d\n%!"
command exitcode;
exit 3
let mkdir dir =
if not (Sys.file_exists dir) then
let quoted_dir = "\"" ^ dir ^ "\"" in
run_system_command ("mkdir " ^ quoted_dir)
let rec make_directory dir =
if Sys.file_exists dir then ()
else (make_directory (Filename.dirname dir); mkdir dir)
let string_of_file filename =
let chan = open_in_bin filename in
let filesize = in_channel_length chan in
if filesize > Sys.max_string_length then
begin
close_in chan;
failwith
("The file " ^ filename ^ " is too large to be loaded into a string")
end else begin
let result =
try really_input_string chan filesize
with End_of_file ->
close_in chan;
failwith ("Got unexpected end of file while reading " ^ filename) in
close_in chan;
result
end
let with_input_file ?(bin=false) x f =
let ic = (if bin then open_in_bin else open_in) x in
try let res = f ic in close_in ic; res with e -> (close_in ic; raise e)
let with_output_file ?(bin=false) x f =
let oc = (if bin then open_out_bin else open_out) x in
try let res = f oc in close_out oc; res with e -> (close_out oc; raise e)
let copy_chan ic oc =
let m = in_channel_length ic in
let m = (m lsr 12) lsl 12 in
let m = max 16384 (min Sys.max_string_length m) in
let buf = Bytes.create m in
let rec loop () =
let len = input ic buf 0 m in
if len > 0 then begin
output oc buf 0 len;
loop ()
end
in loop ()
let copy_file src dest =
with_input_file ~bin:true src begin fun ic ->
with_output_file ~bin:true dest begin fun oc ->
copy_chan ic oc
end
end
end
module StringSet = struct
include Set.Make (String)
let string_of_stringset s = String.concat ", " (elements s)
end
module StringMap : Map.S with type key = string = Map.Make (String)

60
ocamltest/ocamltest_stdlib.mli Normal file
View File

@ -0,0 +1,60 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* A few extensions to OCaml's standard library *)
(* Pervasive *)
val input_line_opt : in_channel -> string option
module Char : sig
include module type of Char
val is_blank : char -> bool
end
module Filename : sig
include module type of Filename
val path_sep : string
val maybe_quote : string -> string
val make_filename : string -> string -> string
val make_path : string list -> string
val mkexe : string -> string
end
module List : sig
include module type of List
val concatmap : ('a -> 'b list) -> 'a list -> 'b list
end
module String : sig
include module type of String
val words : string -> string list
end
module Sys : sig
include module type of Sys
val file_is_empty : string -> bool
val run_system_command : string -> unit
val make_directory : string -> unit
val string_of_file : string -> string
val copy_file : string -> string -> unit
end
module StringSet : sig
include Set.S with type elt = string
val string_of_stringset : t -> string
end
module StringMap : Map.S with type key = string

18
ocamltest/options.ml
View File

@ -21,7 +21,7 @@ let show_objects title string_of_object objects =
List.iter print_object objects;
exit 0
let string_of_action action = action.Actions.action_name
let string_of_action = Actions.action_name
let string_of_test test =
if test.Tests.test_run_by_default
@ -36,22 +36,20 @@ let show_tests () =
let tests = Tests.get_registered_tests () in
show_objects "Available tests are:" string_of_test tests
let log_to_stderr = ref false
let commandline_options =
[
("-e", Arg.Set log_to_stderr, "Log to stderr instead of a file.");
("-show-actions", Arg.Unit show_actions, "Show available actions.");
("-show-tests", Arg.Unit show_tests, "Show available tests.");
]
let testfile = ref ""
let files_to_test = ref []
let set_testfile name =
if !testfile<> "" then
begin
Printf.eprintf "Can't deal with more than one test file at the moment\n%!";
exit 1
end else testfile := name
let add_testfile name = files_to_test := !files_to_test @ [name]
let usage = "Usage: " ^ Sys.argv.(0) ^ " options testfile"
let usage = "Usage: " ^ Sys.argv.(0) ^ " options files to test"
let _ =
Arg.parse commandline_options set_testfile usage
Arg.parse commandline_options add_testfile usage

4
ocamltest/options.mli
View File

@ -15,6 +15,8 @@
(* Description of ocamltest's command-line options *)
val testfile : string ref
val log_to_stderr : bool ref
val files_to_test : string list ref
val usage : string

2
ocamltest/run.h
View File

@ -29,7 +29,7 @@ typedef void Logger(void *, const char *, va_list ap);
typedef struct {
char_os *program;
array argv;
/* array envp; */
array envp;
char_os *stdin_filename;
char_os *stdout_filename;
char_os *stderr_filename;

9
ocamltest/run_command.ml
View File

@ -15,10 +15,12 @@
(* Run programs and log their stdout/stderr, with a timer... *)
open Ocamltest_stdlib
type settings = {
progname : string;
argv : string array;
(* envp : string array; *)
envp : string array;
stdin_filename : string;
stdout_filename : string;
stderr_filename : string;
@ -28,14 +30,15 @@ type settings = {
}
let settings_of_commandline ?(stdout_fname="") ?(stderr_fname="") commandline =
let words = Testlib.words commandline in
let words = String.words commandline in
let quoted_words =
if Sys.os_type="Win32"
then List.map Testlib.maybe_quote words
then List.map Filename.maybe_quote words
else words in
{
progname = List.hd quoted_words;
argv = Array.of_list quoted_words;
envp = [||];
stdin_filename = "";
stdout_filename = stdout_fname;
stderr_filename = stderr_fname;

2
ocamltest/run_command.mli
View File

@ -18,7 +18,7 @@
type settings = {
progname : string;
argv : string array;
(* envp : string array; *)
envp : string array;
stdin_filename : string;
stdout_filename : string;
stderr_filename : string;

21
ocamltest/run_stubs.c
View File

@ -83,19 +83,24 @@ CAMLprim value caml_run_command(value caml_settings)
command_settings settings;
CAMLparam1(caml_settings);
settings.program = caml_stat_strdup_to_os(String_val(Field(caml_settings, 0)));
settings.program =
caml_stat_strdup_to_os(String_val(Field(caml_settings, 0)));
settings.argv = cstringvect(Field(caml_settings, 1));
/* settings.envp = cstringvect(Field(caml_settings, 2)); */
settings.stdin_filename = caml_stat_strdup_to_os(String_val(Field(caml_settings, 2)));
settings.stdout_filename = caml_stat_strdup_to_os(String_val(Field(caml_settings, 4)));
settings.stderr_filename = caml_stat_strdup_to_os(String_val(Field(caml_settings, 4)));
settings.append = Bool_val(Field(caml_settings, 5));
settings.timeout = Int_val(Field(caml_settings, 6));
settings.envp = cstringvect(Field(caml_settings, 2));
settings.stdin_filename =
caml_stat_strdup_to_os(String_val(Field(caml_settings, 3)));
settings.stdout_filename =
caml_stat_strdup_to_os(String_val(Field(caml_settings, 4)));
settings.stderr_filename =
caml_stat_strdup_to_os(String_val(Field(caml_settings, 5)));
settings.append = Bool_val(Field(caml_settings, 6));
settings.timeout = Int_val(Field(caml_settings, 7));
settings.logger = logToChannel;
settings.loggerData = Channel(Field(caml_settings, 7));
settings.loggerData = Channel(Field(caml_settings, 8));
res = run_command(&settings);
caml_stat_free(settings.program);
free_cstringvect(settings.argv);
free_cstringvect(settings.envp);
caml_stat_free(settings.stdin_filename);
caml_stat_free(settings.stdout_filename);
caml_stat_free(settings.stderr_filename);

25
ocamltest/run_unix.c
View File

@ -122,6 +122,27 @@ static int paths_same_file(
return same_file;
}
static void update_environment(array local_env)
{
array envp;
for (envp = local_env; *envp != NULL; envp++) {
char *pos_eq = strchr(*envp, '=');
if (pos_eq != NULL) {
char *name, *value;
int name_length = pos_eq - *envp;
int l = strlen(*envp);
int value_length = l - (name_length +1);
name = malloc(name_length+1);
value = malloc(value_length+1);
memcpy(name, *envp, name_length);
name[name_length] = '\0';
memcpy(value, pos_eq + 1, value_length);
value[value_length] = '\0';
setenv(name, value, 1); /* 1 means overwrite */
}
}
}
static int run_command_child(const command_settings *settings)
{
int res;
@ -168,7 +189,9 @@ static int run_command_child(const command_settings *settings)
myperror("dup2 for stderr");
}
res = execvp(settings->program, settings->argv); /* , settings->envp); */
update_environment(settings->envp);
res = execvp(settings->program, settings->argv);
myperror("Cannot execute %s", settings->program);
return res;

81
ocamltest/run_win32.c
View File

@ -36,19 +36,25 @@ static void report_error(
const command_settings *settings,
const char *message, const WCHAR *argument)
{
WCHAR error_message[1024];
WCHAR windows_error_message[1024];
DWORD error = GetLastError();
char *error_message_c;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, NULL, error, 0,
error_message, sizeof(error_message)/sizeof(WCHAR), NULL);
error_message_c = caml_stat_strdup_of_utf16(error_message);
char *caml_error_message, buf[256];
if (FormatMessage(
FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
NULL, error, 0, windows_error_message,
sizeof(windows_error_message)/sizeof(WCHAR), NULL) ) {
caml_error_message = caml_stat_strdup_of_utf16(windows_error_message);
} else {
caml_error_message = caml_stat_alloc(256);
sprintf(caml_error_message, "unknown Windows error #%lu", error);
}
if ( is_defined(argument) )
error_with_location(file, line,
settings, "%s %s: %s", message, argument, error_message_c);
settings, "%s %s: %s", message, argument, caml_error_message);
else
error_with_location(file, line,
settings, "%s: %s", message, error_message_c);
caml_stat_free(error_message_c);
settings, "%s: %s", message, caml_error_message);
caml_stat_free(caml_error_message);
}
static WCHAR *find_program(const WCHAR *program_name)
@ -132,6 +138,61 @@ static WCHAR *commandline_of_arguments(WCHAR **arguments)
return commandline;
}
static LPVOID prepare_environment(WCHAR **localenv)
{
LPTCH p, r, env, process_env = NULL;
WCHAR **q;
int l, process_env_length, localenv_length, env_length;
if (localenv == NULL) return NULL;
process_env = GetEnvironmentStrings();
if (process_env == NULL) return NULL;
/* Compute length of process environment */
process_env_length = 0;
p = process_env;
while (*p != L'\0') {
l = wcslen(p) + 1; /* also count terminating '\0' */
process_env_length += l;
p += l;
}
/* Compute length of local environment */
localenv_length = 0;
q = localenv;
while (*q != NULL) {
localenv_length += wcslen(*q) + 1;
q++;
}
/* Build new env that contains both process and local env */
env_length = process_env_length + localenv_length + 1;
env = malloc(env_length * sizeof(WCHAR));
if (env == NULL) {
FreeEnvironmentStrings(process_env);
return NULL;
}
r = env;
p = process_env;
while (*p != L'\0') {
l = wcslen(p) + 1; /* also count terminating '\0' */
memcpy(r, p, l * sizeof(WCHAR));
p += l;
r += l;
}
FreeEnvironmentStrings(process_env);
q = localenv;
while (*q != NULL) {
l = wcslen(*q) + 1;
memcpy(r, *q, l * sizeof(WCHAR));
r += l;
q++;
}
*r = L'\0';
return env;
}
static SECURITY_ATTRIBUTES security_attributes = {
sizeof(SECURITY_ATTRIBUTES), /* nLength */
NULL, /* lpSecurityDescriptor */
@ -206,6 +267,8 @@ int run_command(const command_settings *settings)
commandline = commandline_of_arguments(settings->argv);
environment = prepare_environment(settings->envp);
if (is_defined(settings->stdin_filename))
{
startup_info.hStdInput = create_input_handle(settings->stdin_filename);
@ -258,7 +321,7 @@ int run_command(const command_settings *settings)
NULL, /* SECURITY_ATTRIBUTES thread_attributes */
TRUE, /* BOOL inherit_handles */
CREATE_UNICODE_ENVIRONMENT, /* DWORD creation_flags */
NULL, /* LPVOID environment */
environment,
NULL, /* LPCSTR current_directory */
&startup_info,
&process_info

134
ocamltest/testlib.ml
View File

@ -1,134 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Sebastien Hinderer, projet Gallium, INRIA Paris *)
(* *)
(* Copyright 2016 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Miscellaneous library functions *)
let rec concatmap f = function
| [] -> []
| x::xs -> (f x) @ (concatmap f xs)
let is_blank c =
c = ' ' || c = '\012' || c = '\n' || c = '\r' || c = '\t'
let string_of_char = String.make 1
(* This function comes from otherlibs/win32unix/unix.ml *)
let maybe_quote f =
if String.contains f ' ' ||
String.contains f '\"' ||
String.contains f '\t' ||
f = ""
then Filename.quote f
else f
let words s =
let l = String.length s in
let rec f quote w ws i =
if i>=l then begin
if w<>"" then List.rev (w::ws)
else List.rev ws
end else begin
let j = i+1 in
match s.[i] with
| '\'' -> f (not quote) w ws j
| ' ' ->
begin
if quote
then f true (w ^ (string_of_char ' ')) ws j
else begin
if w=""
then f false w ws j
else f false "" (w::ws) j
end
end
| _ as c -> f quote (w ^ (string_of_char c)) ws j
end in
if l=0 then [] else f false "" [] 0
let file_is_empty filename =
let ic = open_in filename in
let filesize = in_channel_length ic in
close_in ic;
filesize = 0
let string_of_location loc =
let buf = Buffer.create 64 in
let fmt = Format.formatter_of_buffer buf in
Location.print_loc fmt loc;
Format.pp_print_flush fmt ();
Buffer.contents buf
let run_system_command command = match Sys.command command with
| 0 -> ()
| _ as exitcode ->
Printf.eprintf "Sysem command %s failed with status %d\n%!"
command exitcode;
exit 3
let mkdir dir =
if not (Sys.file_exists dir) then
let quoted_dir = "\"" ^ dir ^ "\"" in
run_system_command ("mkdir " ^ quoted_dir)
let rec make_directory dir =
if Sys.file_exists dir then ()
else (make_directory (Filename.dirname dir); mkdir dir)
let string_of_file filename =
let chan = open_in_bin filename in
let filesize = in_channel_length chan in
if filesize > Sys.max_string_length then
begin
close_in chan;
failwith
("The file " ^ filename ^ " is too large to be loaded into a string")
end else begin
let result =
try really_input_string chan filesize
with End_of_file ->
close_in chan;
failwith ("Got unexpected end of file while reading " ^ filename) in
close_in chan;
result
end
let with_input_file ?(bin=false) x f =
let ic = (if bin then open_in_bin else open_in) x in
try let res = f ic in close_in ic; res with e -> (close_in ic; raise e)
let with_output_file ?(bin=false) x f =
let oc = (if bin then open_out_bin else open_out) x in
try let res = f oc in close_out oc; res with e -> (close_out oc; raise e)
let copy_chan ic oc =
let m = in_channel_length ic in
let m = (m lsr 12) lsl 12 in
let m = max 16384 (min Sys.max_string_length m) in
let buf = Bytes.create m in
let rec loop () =
let len = input ic buf 0 m in
if len > 0 then begin
output oc buf 0 len;
loop ()
end
in loop ()
let copy_file src dest =
with_input_file ~bin:true src begin fun ic ->
with_output_file ~bin:true dest begin fun oc ->
copy_chan ic oc
end
end

6
ocamltest/tests.ml
View File

@ -43,7 +43,7 @@ let lookup name =
let test_of_action action =
{
test_name = action.Actions.action_name;
test_name = Actions.action_name action;
test_run_by_default = false;
test_actions = [action]
}
@ -55,7 +55,7 @@ let run_actions log testenv actions =
| action::remaining_actions ->
begin
Printf.fprintf log "Running action %d/%d (%s)\n%!"
action_number total action.Actions.action_name;
action_number total (Actions.action_name action);
let result = Actions.run log env action in
let report = match result with
| Actions.Pass _ -> "succeded."
@ -64,7 +64,7 @@ let run_actions log testenv actions =
| Actions.Skip reason ->
("has been skipped for the following reason:\n" ^ reason) in
Printf.fprintf log "Action %d/%d (%s) %s\n%!"
action_number total action.Actions.action_name
action_number total (Actions.action_name action)
report;
match result with
| Actions.Pass env' ->

2
ocamltest/tsl_lexer.mll
View File

@ -28,7 +28,7 @@ let lexer_error message =
let newline = ('\013'* '\010')
let blank = [' ' '\009' '\012']
let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
let identchar = ['A'-'Z' 'a'-'z' '_' '.' '-' '\'' '0'-'9']
rule token = parse
| blank * { token lexbuf }

32
ocamltest/tsl_semantics.ml
View File

@ -17,16 +17,20 @@
open Tsl_ast
let variable_already_defined loc variable context =
let ctxt = match context with
| None -> ""
| Some envname -> " while including environment " ^ envname in
let locstr = Testlib.string_of_location loc in
Printf.eprintf "%s\nVariable %s already defined%s\n%!" locstr variable ctxt;
let string_of_location loc =
let buf = Buffer.create 64 in
let fmt = Format.formatter_of_buffer buf in
Location.print_loc fmt loc;
Format.pp_print_flush fmt ();
Buffer.contents buf
let no_such_variable loc name =
let locstr = string_of_location loc in
Printf.eprintf "%s\nNo such variable %s\n%!" locstr name;
exit 2
let no_such_modifiers loc name =
let locstr = Testlib.string_of_location loc in
let locstr = string_of_location loc in
Printf.eprintf "%s\nNo such modifiers %s\n%!" locstr name;
exit 2
@ -36,21 +40,17 @@ let apply_modifiers env modifiers_name =
try Environments.apply_modifier env modifier with
| Environments.Modifiers_name_not_found name ->
no_such_modifiers modifiers_name.loc name
| Environments.Variable_already_defined variable ->
variable_already_defined modifiers_name.loc
(Variables.name_of_variable variable) (Some name)
let interprete_environment_statement env statement = match statement.node with
| Assignment (var, value) ->
begin
let variable_name = var.node in
let variable = match Variables.find_variable variable_name with
| None -> Variables.make (variable_name, "User variable")
| None -> raise (Variables.No_such_variable variable_name)
| Some variable -> variable in
try Environments.add variable value.node env with
Environments.Variable_already_defined variable ->
variable_already_defined statement.loc
(Variables.name_of_variable variable) None
| Variables.No_such_variable name ->
no_such_variable statement.loc name
end
| Include modifiers_name -> apply_modifiers env modifiers_name
@ -70,12 +70,12 @@ let too_deep testname max_level real_level =
exit 2
let unexpected_environment_statement s =
let locstr = Testlib.string_of_location s.loc in
let locstr = string_of_location s.loc in
Printf.eprintf "%s\nUnexpected environment statement\n%!" locstr;
exit 2
let no_such_test_or_action t =
let locstr = Testlib.string_of_location t.loc in
let locstr = string_of_location t.loc in
Printf.eprintf "%s\nNo such test or action: %s\n%!" locstr t.node;
exit 2

2
ocamltest/variables.ml
View File

@ -26,6 +26,8 @@ exception Empty_variable_name
exception Variable_already_registered
exception No_such_variable of string
let make (name, description) =
if name="" then raise Empty_variable_name else {
variable_name = name;

2
ocamltest/variables.mli
View File

@ -23,6 +23,8 @@ exception Empty_variable_name
exception Variable_already_registered
exception No_such_variable of string
val make : string * string -> t
val name_of_variable : t -> string