diff --git a/ocamltest/.depend b/ocamltest/.depend index 5e12b1abf..ff3cfaf85 100644 --- a/ocamltest/.depend +++ b/ocamltest/.depend @@ -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 diff --git a/ocamltest/Makefile b/ocamltest/Makefile index b674e15d6..8b8c456cc 100644 --- a/ocamltest/Makefile +++ b/ocamltest/Makefile @@ -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 diff --git a/ocamltest/actions.ml b/ocamltest/actions.ml index 6df72c5c6..8ef01cac0 100644 --- a/ocamltest/actions.ml +++ b/ocamltest/actions.ml @@ -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 diff --git a/ocamltest/actions.mli b/ocamltest/actions.mli index e9bde8536..03d862762 100644 --- a/ocamltest/actions.mli +++ b/ocamltest/actions.mli @@ -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 diff --git a/ocamltest/actions_helpers.ml b/ocamltest/actions_helpers.ml new file mode 100644 index 000000000..c080731be --- /dev/null +++ b/ocamltest/actions_helpers.ml @@ -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) diff --git a/ocamltest/testlib.mli b/ocamltest/actions_helpers.mli similarity index 52% rename from ocamltest/testlib.mli rename to ocamltest/actions_helpers.mli index 70ecc7e95..57ce5d9e6 100644 --- a/ocamltest/testlib.mli +++ b/ocamltest/actions_helpers.mli @@ -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 diff --git a/ocamltest/builtin_actions.ml b/ocamltest/builtin_actions.ml index f4ec3bf2d..38cf2681f 100644 --- a/ocamltest/builtin_actions.ml +++ b/ocamltest/builtin_actions.ml @@ -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; ] diff --git a/ocamltest/builtin_actions.mli b/ocamltest/builtin_actions.mli index 74ea5e8cb..2152ea123 100644 --- a/ocamltest/builtin_actions.mli +++ b/ocamltest/builtin_actions.mli @@ -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 diff --git a/ocamltest/builtin_variables.ml b/ocamltest/builtin_variables.ml index 987da1947..104a4a6f4 100644 --- a/ocamltest/builtin_variables.ml +++ b/ocamltest/builtin_variables.ml @@ -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; ] diff --git a/ocamltest/builtin_variables.mli b/ocamltest/builtin_variables.mli index 0b0c8aec9..c21083062 100644 --- a/ocamltest/builtin_variables.mli +++ b/ocamltest/builtin_variables.mli @@ -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 diff --git a/ocamltest/environments.ml b/ocamltest/environments.ml index fa239da9f..de3086fed 100644 --- a/ocamltest/environments.ml +++ b/ocamltest/environments.ml @@ -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 diff --git a/ocamltest/environments.mli b/ocamltest/environments.mli index be19f8e68..8bb11dda5 100644 --- a/ocamltest/environments.mli +++ b/ocamltest/environments.mli @@ -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 diff --git a/ocamltest/filecompare.ml b/ocamltest/filecompare.ml index 2fe59c29d..38cc8a4d9 100644 --- a/ocamltest/filecompare.ml +++ b/ocamltest/filecompare.ml @@ -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) diff --git a/ocamltest/main.ml b/ocamltest/main.ml index a86d0ecb0..86d43d72e 100644 --- a/ocamltest/main.ml +++ b/ocamltest/main.ml @@ -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() diff --git a/ocamltest/ocaml_actions.ml b/ocamltest/ocaml_actions.ml new file mode 100644 index 000000000..ae2ce2e93 --- /dev/null +++ b/ocamltest/ocaml_actions.ml @@ -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; + ] diff --git a/ocamltest/builtin_modifiers.ml b/ocamltest/ocaml_actions.mli similarity index 53% rename from ocamltest/builtin_modifiers.ml rename to ocamltest/ocaml_actions.mli index 9fc930d2a..102bf0168 100644 --- a/ocamltest/builtin_modifiers.ml +++ b/ocamltest/ocaml_actions.mli @@ -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 diff --git a/ocamltest/backends.ml b/ocamltest/ocaml_backends.ml similarity index 98% rename from ocamltest/backends.ml rename to ocamltest/ocaml_backends.ml index c92e9696d..1a41d3c39 100644 --- a/ocamltest/backends.ml +++ b/ocamltest/ocaml_backends.ml @@ -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 diff --git a/ocamltest/backends.mli b/ocamltest/ocaml_backends.mli similarity index 98% rename from ocamltest/backends.mli rename to ocamltest/ocaml_backends.mli index 6d651ae05..f6dae804a 100644 --- a/ocamltest/backends.mli +++ b/ocamltest/ocaml_backends.mli @@ -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 diff --git a/ocamltest/ocaml_modifiers.ml b/ocamltest/ocaml_modifiers.ml new file mode 100644 index 000000000..267870ff5 --- /dev/null +++ b/ocamltest/ocaml_modifiers.ml @@ -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 diff --git a/ocamltest/builtin_modifiers.mli b/ocamltest/ocaml_modifiers.mli similarity index 90% rename from ocamltest/builtin_modifiers.mli rename to ocamltest/ocaml_modifiers.mli index f35b89707..1212495d6 100644 --- a/ocamltest/builtin_modifiers.mli +++ b/ocamltest/ocaml_modifiers.mli @@ -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 diff --git a/ocamltest/builtin_tests.ml b/ocamltest/ocaml_tests.ml similarity index 77% rename from ocamltest/builtin_tests.ml rename to ocamltest/ocaml_tests.ml index 9e8d85c28..91903fb1d 100644 --- a/ocamltest/builtin_tests.ml +++ b/ocamltest/ocaml_tests.ml @@ -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; *) ] diff --git a/ocamltest/builtin_tests.mli b/ocamltest/ocaml_tests.mli similarity index 96% rename from ocamltest/builtin_tests.mli rename to ocamltest/ocaml_tests.mli index 271bf346d..4ee62505b 100644 --- a/ocamltest/builtin_tests.mli +++ b/ocamltest/ocaml_tests.mli @@ -13,7 +13,7 @@ (* *) (**************************************************************************) -(* Definitions of built-in tests *) +(* Tests specific to the OCaml compiler *) val bytecode : Tests.t diff --git a/ocamltest/ocaml_variables.ml b/ocamltest/ocaml_variables.ml new file mode 100644 index 000000000..a74db565f --- /dev/null +++ b/ocamltest/ocaml_variables.ml @@ -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 *) + ] diff --git a/ocamltest/ocaml_variables.mli b/ocamltest/ocaml_variables.mli new file mode 100644 index 000000000..73a196fae --- /dev/null +++ b/ocamltest/ocaml_variables.mli @@ -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 diff --git a/ocamltest/ocamltest_stdlib.ml b/ocamltest/ocamltest_stdlib.ml new file mode 100644 index 000000000..3245eab72 --- /dev/null +++ b/ocamltest/ocamltest_stdlib.ml @@ -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) diff --git a/ocamltest/ocamltest_stdlib.mli b/ocamltest/ocamltest_stdlib.mli new file mode 100644 index 000000000..da48a4f54 --- /dev/null +++ b/ocamltest/ocamltest_stdlib.mli @@ -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 diff --git a/ocamltest/options.ml b/ocamltest/options.ml index 04b2fbb07..01c785885 100644 --- a/ocamltest/options.ml +++ b/ocamltest/options.ml @@ -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 diff --git a/ocamltest/options.mli b/ocamltest/options.mli index 57fe7a3d5..67da72183 100644 --- a/ocamltest/options.mli +++ b/ocamltest/options.mli @@ -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 diff --git a/ocamltest/run.h b/ocamltest/run.h index 348d16da7..7c13212e1 100644 --- a/ocamltest/run.h +++ b/ocamltest/run.h @@ -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; diff --git a/ocamltest/run_command.ml b/ocamltest/run_command.ml index 55b4b1392..1a1df6147 100644 --- a/ocamltest/run_command.ml +++ b/ocamltest/run_command.ml @@ -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; diff --git a/ocamltest/run_command.mli b/ocamltest/run_command.mli index 9fcdadb19..30033ce3e 100644 --- a/ocamltest/run_command.mli +++ b/ocamltest/run_command.mli @@ -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; diff --git a/ocamltest/run_stubs.c b/ocamltest/run_stubs.c index 9505b076e..2f89e83dc 100644 --- a/ocamltest/run_stubs.c +++ b/ocamltest/run_stubs.c @@ -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); diff --git a/ocamltest/run_unix.c b/ocamltest/run_unix.c index 5416016d5..50f143182 100644 --- a/ocamltest/run_unix.c +++ b/ocamltest/run_unix.c @@ -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; diff --git a/ocamltest/run_win32.c b/ocamltest/run_win32.c index b60e5dacc..0a1f53def 100644 --- a/ocamltest/run_win32.c +++ b/ocamltest/run_win32.c @@ -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 diff --git a/ocamltest/testlib.ml b/ocamltest/testlib.ml deleted file mode 100644 index e24e6abd7..000000000 --- a/ocamltest/testlib.ml +++ /dev/null @@ -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 diff --git a/ocamltest/tests.ml b/ocamltest/tests.ml index 0a93ac70b..a2f3c667f 100644 --- a/ocamltest/tests.ml +++ b/ocamltest/tests.ml @@ -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' -> diff --git a/ocamltest/tsl_lexer.mll b/ocamltest/tsl_lexer.mll index b14cee89b..0bf925a8f 100644 --- a/ocamltest/tsl_lexer.mll +++ b/ocamltest/tsl_lexer.mll @@ -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 } diff --git a/ocamltest/tsl_semantics.ml b/ocamltest/tsl_semantics.ml index ca4b77402..f22a0f89a 100644 --- a/ocamltest/tsl_semantics.ml +++ b/ocamltest/tsl_semantics.ml @@ -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 diff --git a/ocamltest/variables.ml b/ocamltest/variables.ml index 2762ef39c..834b2a5d9 100644 --- a/ocamltest/variables.ml +++ b/ocamltest/variables.ml @@ -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; diff --git a/ocamltest/variables.mli b/ocamltest/variables.mli index 4c63001f3..17487eef2 100644 --- a/ocamltest/variables.mli +++ b/ocamltest/variables.mli @@ -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