ocamltest: introduce the result module

This module contains types describing test results and functions to
build and use them.

Before this commit, only successful actions were returning an environemnt.
Starting from this commit, actions always return an environemnt, no matter
their result.

This will make it possible to write negations over tests.

ocamltest/.depend

@@ -8,20 +8,20 @@ run_stubs.$(O): run_stubs.c run.h ../byterun/caml/misc.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.cmo : result.cmi environments.cmi actions.cmi
-actions.cmx : environments.cmx actions.cmi
+actions.cmx : result.cmx environments.cmx actions.cmi
-actions.cmi : environments.cmi
+actions.cmi : result.cmi environments.cmi
-actions_helpers.cmo : variables.cmi run_command.cmi ocamltest_stdlib.cmi \
+actions_helpers.cmo : variables.cmi run_command.cmi result.cmi \
-    filecompare.cmi environments.cmi builtin_variables.cmi actions.cmi \
+    ocamltest_stdlib.cmi filecompare.cmi environments.cmi \
-    actions_helpers.cmi
+    builtin_variables.cmi actions_helpers.cmi
-actions_helpers.cmx : variables.cmx run_command.cmx ocamltest_stdlib.cmx \
+actions_helpers.cmx : variables.cmx run_command.cmx result.cmx \
-    filecompare.cmx environments.cmx builtin_variables.cmx actions.cmx \
+    ocamltest_stdlib.cmx filecompare.cmx environments.cmx \
-    actions_helpers.cmi
+    builtin_variables.cmx actions_helpers.cmi
-actions_helpers.cmi : variables.cmi environments.cmi actions.cmi
+actions_helpers.cmi : variables.cmi result.cmi environments.cmi actions.cmi
-builtin_actions.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
+builtin_actions.cmo : result.cmi ocamltest_stdlib.cmi ocamltest_config.cmi \
     environments.cmi builtin_variables.cmi actions_helpers.cmi actions.cmi \
     builtin_actions.cmi
-builtin_actions.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
+builtin_actions.cmx : result.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
@@ -38,18 +38,18 @@ filetype.cmo : filetype.cmi
 filetype.cmx : filetype.cmi
 filetype.cmi :
 main.cmo : tsl_semantics.cmi tsl_parser.cmi tsl_lexer.cmi tests.cmi \
-    options.cmi ocamltest_stdlib.cmi environments.cmi builtin_variables.cmi \
+    result.cmi options.cmi ocamltest_stdlib.cmi environments.cmi \
-    actions_helpers.cmi actions.cmi main.cmi
+    builtin_variables.cmi actions_helpers.cmi actions.cmi main.cmi
 main.cmx : tsl_semantics.cmx tsl_parser.cmx tsl_lexer.cmx tests.cmx \
-    options.cmx ocamltest_stdlib.cmx environments.cmx builtin_variables.cmx \
+    result.cmx options.cmx ocamltest_stdlib.cmx environments.cmx \
-    actions_helpers.cmx actions.cmx main.cmi
+    builtin_variables.cmx actions_helpers.cmx actions.cmx main.cmi
 main.cmi :
-ocaml_actions.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
+ocaml_actions.cmo : result.cmi ocamltest_stdlib.cmi ocamltest_config.cmi \
     ocaml_variables.cmi ocaml_flags.cmi ocaml_files.cmi ocaml_directories.cmi \
     ocaml_compilers.cmi ocaml_commands.cmi ocaml_backends.cmi filetype.cmi \
     filecompare.cmi environments.cmi builtin_variables.cmi \
     actions_helpers.cmi actions.cmi ocaml_actions.cmi
-ocaml_actions.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
+ocaml_actions.cmx : result.cmx ocamltest_stdlib.cmx ocamltest_config.cmx \
     ocaml_variables.cmx ocaml_flags.cmx ocaml_files.cmx ocaml_directories.cmx \
     ocaml_compilers.cmx ocaml_commands.cmx ocaml_backends.cmx filetype.cmx \
     filecompare.cmx environments.cmx builtin_variables.cmx \
@@ -61,13 +61,13 @@ ocaml_backends.cmi : ocamltest_stdlib.cmi
 ocaml_commands.cmo : ocaml_files.cmi ocaml_commands.cmi
 ocaml_commands.cmx : ocaml_files.cmx ocaml_commands.cmi
 ocaml_commands.cmi :
-ocaml_compilers.cmo : variables.cmi ocaml_variables.cmi ocaml_files.cmi \
+ocaml_compilers.cmo : variables.cmi ocamltest_stdlib.cmi ocaml_variables.cmi \
-    ocaml_commands.cmi ocaml_backends.cmi environments.cmi \
+    ocaml_files.cmi ocaml_commands.cmi ocaml_backends.cmi environments.cmi \
     ocaml_compilers.cmi
-ocaml_compilers.cmx : variables.cmx ocaml_variables.cmx ocaml_files.cmx \
+ocaml_compilers.cmx : variables.cmx ocamltest_stdlib.cmx ocaml_variables.cmx \
-    ocaml_commands.cmx ocaml_backends.cmx environments.cmx \
+    ocaml_files.cmx ocaml_commands.cmx ocaml_backends.cmx environments.cmx \
     ocaml_compilers.cmi
-ocaml_compilers.cmi : variables.cmi environments.cmi
+ocaml_compilers.cmi : variables.cmi ocamltest_stdlib.cmi environments.cmi
 ocaml_directories.cmo : ocamltest_stdlib.cmi ocamltest_config.cmi \
     ocaml_directories.cmi
 ocaml_directories.cmx : ocamltest_stdlib.cmx ocamltest_config.cmx \
@@ -105,12 +105,15 @@ ocamltest_stdlib.cmi :
 options.cmo : tests.cmi actions.cmi options.cmi
 options.cmx : tests.cmx actions.cmx options.cmi
 options.cmi :
+result.cmo : result.cmi
+result.cmx : result.cmi
+result.cmi :
 run_command.cmo : ocamltest_stdlib.cmi run_command.cmi
 run_command.cmx : ocamltest_stdlib.cmx run_command.cmi
 run_command.cmi :
-tests.cmo : actions.cmi tests.cmi
+tests.cmo : result.cmi actions.cmi tests.cmi
-tests.cmx : actions.cmx tests.cmi
+tests.cmx : result.cmx actions.cmx tests.cmi
-tests.cmi : environments.cmi actions.cmi
+tests.cmi : result.cmi environments.cmi actions.cmi
 tsl_ast.cmo : tsl_ast.cmi
 tsl_ast.cmx : tsl_ast.cmi
 tsl_ast.cmi :

ocamltest/Makefile

@@ -50,6 +50,7 @@ core := \
   filecompare.mli filecompare.ml \
   variables.mli variables.ml \
   environments.mli environments.ml \
+  result.mli result.ml \
   actions.mli actions.ml \
   tests.mli tests.ml \
   tsl_ast.mli tsl_ast.ml \

ocamltest/actions.ml

@@ -15,21 +15,7 @@
 
 (* Definition of actions, basic blocks for tests *)
 
-type result =
+type code = out_channel -> Environments.t -> Result.t * Environments.t
-  | Pass of Environments.t
-  | Fail of string
-  | Skip of string
-
-let string_of_reason prefix reason =
-  if reason="" then prefix
-  else prefix ^ " (" ^ reason ^ ")"
-
-let string_of_result = function
-  | Pass _ -> "Pass"
-  | Fail reason -> string_of_reason "Fail" reason
-  | Skip reason -> string_of_reason "Skip" reason
-
-type code = out_channel -> Environments.t -> result
 
 type t = {
   name : string;

ocamltest/actions.mli

@@ -15,14 +15,7 @@
 
 (* Definition of actions, basic blocks for tests *)
 
-type result =
+type code = out_channel -> Environments.t -> Result.t * Environments.t
-  | Pass of Environments.t
-  | Fail of string
-  | Skip of string
-
-val string_of_result : result -> string
-
-type code = out_channel -> Environments.t -> result
 
 type t
 
@@ -42,6 +35,6 @@ 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
+val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
 
 module ActionSet : Set.S with type elt = t

ocamltest/actions_helpers.ml

@@ -16,13 +16,14 @@
 (* Helper functions when writing actions *)
 
 open Ocamltest_stdlib
-open Actions
 
-let pass_or_skip test log_on_pass log_on_skip log env =
+let pass_or_skip test pass_reason skip_reason _log env =
-  if test then begin
+  let open Result in
-    Printf.fprintf log "%s%!" log_on_pass;
+  let result =
-    Pass env
+    if test
-  end else Skip log_on_skip
+    then pass_with_reason pass_reason
+    else skip_with_reason skip_reason in
+  (result, env)
 
 let mkreason what commandline exitcode =
   Printf.sprintf "%s: command\n%s\nfailed with exit code %d"
@@ -69,7 +70,7 @@ let setup_build_env add_testfile additional_files (_log : out_channel) env =
     else some_files in
   setup_symlinks (test_source_directory env) build_dir files;
   Sys.chdir build_dir;
-  Pass env
+  (Result.pass, env)
 
 let setup_simple_build_env add_testfile additional_files log env =
   let build_env = Environments.add
@@ -146,7 +147,7 @@ let run
   | None ->
     let msg = Printf.sprintf "%s: variable %s is undefined"
       log_message (Variables.name_of_variable prog_variable) in
-    Fail msg
+    (Result.fail_with_reason msg, env)
   | Some program ->
     let arguments = match args_variable with
       | None -> ""
@@ -174,13 +175,12 @@ let run
           if redirect_output
           then Environments.add Builtin_variables.output output env
           else env in
-        Pass newenv
+        (Result.pass, newenv)
       | _ as exitcode ->
+        let reason = mkreason what (String.concat " " commandline) exitcode in
         if exitcode = 125 && can_skip
-        then Skip (mkreason
+        then (Result.skip_with_reason reason, execution_env)
-          what (String.concat " " commandline) exitcode)
+        else (Result.fail_with_reason reason, execution_env)
-        else Fail (mkreason
-          what (String.concat " " commandline) exitcode)
 
 let run_program =
   run
@@ -222,11 +222,14 @@ let run_hook hook_name log input_env =
   match exit_status with
     | 0 ->
       let modifiers = Environments.modifiers_of_file response_file in
-      Pass (Environments.apply_modifiers hookenv modifiers)
+      let modified_env = Environments.apply_modifiers hookenv modifiers in
+      (Result.pass, modified_env)
     | _ ->
       Printf.fprintf log "Hook returned %d" exit_status;
       let reason = String.trim (Sys.string_of_file response_file) in
-      if exit_status=125 then Skip reason else Fail reason
+      if exit_status=125
+      then (Result.skip_with_reason reason, hookenv)
+      else (Result.fail_with_reason reason, hookenv)
 
 let check_output kind_of_output output_variable reference_variable log env =
   let reference_filename = Environments.safe_lookup reference_variable env in
@@ -240,7 +243,7 @@ let check_output kind_of_output output_variable reference_variable log env =
     Filecompare.output_filename = output_filename
   } in
   match Filecompare.check_file files with
-    | Filecompare.Same -> Pass env
+    | Filecompare.Same -> (Result.pass, env)
     | Filecompare.Different ->
       let diff = Filecompare.diff files in
       let diffstr = match diff with
@@ -249,7 +252,7 @@ let check_output kind_of_output output_variable reference_variable log env =
       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)
+      (Result.fail_with_reason reason, env)
     | Filecompare.Unexpected_output ->
       let banner = String.make 40 '=' in
       let unexpected_output = Sys.string_of_file output_filename in
@@ -259,8 +262,8 @@ let check_output kind_of_output output_variable reference_variable log env =
         "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)
+      (Result.fail_with_reason reason, env)
     | Filecompare.Error (commandline, exitcode) ->
       let reason = Printf.sprintf "The command %s failed with status %d"
         commandline exitcode in
-      (Fail reason)
+      (Result.fail_with_reason reason, env)

ocamltest/actions_helpers.mli

@@ -16,7 +16,8 @@
 (* Helper functions when writing actions *)
 
 val pass_or_skip
-  : bool -> string -> string -> out_channel -> Environments.t -> Actions.result
+  : bool -> string -> string -> out_channel -> Environments.t
+         -> Result.t * Environments.t
 
 val mkreason : string -> string -> int -> string
 

ocamltest/builtin_actions.ml

@@ -20,33 +20,38 @@ open Actions
 
 let pass = make
   "pass"
-  (fun log env ->
+  (fun _log env ->
-    Printf.fprintf log "The pass action always succeeds.\n%!";
+    let result =
-    Pass env)
+      Result.pass_with_reason "The pass action always succeeds." in
+    (result, env))
 
 let skip = make
   "skip"
-  (fun _log _env -> Skip "The skip action always skips.")
+  (fun _log env ->
+    let result = Result.skip_with_reason "The skip action always skips." in
+    (result, env))
 
 let fail = make
   "fail"
-  (fun _log _env -> Fail "The fail action always fails.")
+  (fun _log env ->
+    let result = Result.fail_with_reason "The fail action always fails." in
+    (result, env))
 
 let dumpenv = make
   "dumpenv"
   (fun log env ->
-    Environments.dump log env; Pass env)
+    Environments.dump log env; (Result.pass, env))
 
 let unix = make
   "unix"
   (Actions_helpers.pass_or_skip Ocamltest_config.unix
-    "The unix action succeeds because we are on a Unix system.\n"
+    "The unix action succeeds because we are on a Unix system."
     "The unix action skips because we are on a Windows system.")
 
 let windows = make
   "windows"
   (Actions_helpers.pass_or_skip (not Ocamltest_config.unix)
-    "The windows action succeeds because we are on a Windows system.\n"
+    "The windows action succeeds because we are on a Windows system."
     "The windows action skips because we are on a Unix system.")
 
 let setup_build_env = make

ocamltest/main.ml

@@ -66,11 +66,10 @@ let rec run_test log common_prefix path behavior = function
     | Run env ->
       let testenv0 = interprete_environment_statements env testenvspec in
       let testenv = List.fold_left apply_modifiers testenv0 env_modifiers in
-      let t = Tests.run log testenv test in
+      let (result, newenv) = Tests.run log testenv test in
-      (match t with
+      let s = Result.string_of_result result in
-      | Actions.Pass env -> "passed", Run env
+      if Result.is_pass result then (s, Run newenv)
-      | Actions.Skip _ -> "skipped", Skip_all_tests
+      else (s, Skip_all_tests) in
-      | Actions.Fail _ -> "failed", Skip_all_tests) in
   Printf.printf "%s\n%!" msg;
   List.iteri (run_test_i log common_prefix path b) subtrees
 and run_test_i log common_prefix path behavior i test_tree =

ocamltest/ocaml_actions.ml

@@ -121,9 +121,15 @@ let compile_program ocamlsrcdir compiler program_variable log env =
       ~append:true
       log env commandline in
   if exit_status=expected_exit_status
-  then Pass (Environments.add program_variable program_file env)
+  then begin
-  else Fail (Actions_helpers.mkreason
+    let newenv = Environments.add program_variable program_file env in
-    what (String.concat " " commandline) exit_status)
+    (Result.pass, newenv)
+  end else begin
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
 
 let compile_module ocamlsrcdir compiler module_ log env =
   let backend = compiler.Ocaml_compilers.backend in
@@ -152,9 +158,13 @@ let compile_module ocamlsrcdir compiler module_ log env =
       ~append:true
       log env commandline in
   if exit_status=expected_exit_status
-  then Pass env
+  then (Result.pass, env)
-  else Fail (Actions_helpers.mkreason
+  else begin
-    what (String.concat " " commandline) exit_status)
+    let reason =
+      (Actions_helpers.mkreason
+        what (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
 
 let module_has_interface directory module_name =
   let interface_name =
@@ -314,30 +324,30 @@ let run_expect_once ocamlsrcdir input_file principal log env =
   ] in
   let exit_status =
     Actions_helpers.run_cmd ~environment:dumb_term log env commandline in
-  if exit_status=0 then Pass env
+  if exit_status=0 then (Result.pass, env)
-  else Fail (Actions_helpers.mkreason
+  else begin
-    "expect" (String.concat " " commandline) exit_status)
+    let reason = (Actions_helpers.mkreason
+      "expect" (String.concat " " commandline) exit_status) in
+    (Result.fail_with_reason reason, env)
+  end
 
 let run_expect_twice ocamlsrcdir input_file log env =
   let corrected filename = Filename.make_filename filename "corrected" in
-  let first_run = run_expect_once ocamlsrcdir input_file false log env in
+  let (result1, env1) = run_expect_once ocamlsrcdir input_file false log env in
-  match first_run with
+  if Result.is_pass result1 then begin
-    | Skip _ | Fail _ -> first_run
+    let intermediate_file = corrected input_file in
-    | Pass env1 ->
+    let (result2, env2) =
-      let intermediate_file = corrected input_file in
+      run_expect_once ocamlsrcdir intermediate_file true log env1 in
-      let second_run =
+    if Result.is_pass result2 then begin
-        run_expect_once ocamlsrcdir intermediate_file true log env1 in
+      let output_file = corrected intermediate_file in
-      (match second_run with
+      let output_env = Environments.add_bindings
-      | Skip _ | Fail _ -> second_run
+      [
-      | Pass env2 ->
+        Builtin_variables.reference, input_file;
-        let output_file = corrected intermediate_file in
+        Builtin_variables.output, output_file
-        let output_env = Environments.add_bindings
+      ] env2 in
-        [
+      (Result.pass, output_env)
-          Builtin_variables.reference, input_file;
+    end else (result2, env2)
-          Builtin_variables.output, output_file
+  end else (result1, env1)
-        ] env2 in
-        Pass output_env
-      )
 
 let run_expect log env =
   let ocamlsrcdir = Ocaml_directories.srcdir () in
@@ -378,15 +388,15 @@ let really_compare_programs backend comparison_tool log env =
   } in
   if Ocamltest_config.flambda && backend = Sys.Native
   then begin
-    Printf.fprintf log
+    let reason =
-      "flambda temporarily disables comparison of native programs";
+      "flambda temporarily disables comparison of native programs" in
-    Pass env
+    (Result.pass_with_reason reason, env)
   end else
   if backend = Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
   then begin
-    Printf.fprintf log
+    let reason =
-      "comparison of native programs temporarily disabled under Windows";
+      "comparison of native programs temporarily disabled under Windows" in
-    Pass env
+    (Result.pass_with_reason reason, env)
   end else begin
     let comparison_tool =
       if backend=Sys.Native && (Sys.os_type="Win32" || Sys.os_type="Cygwin")
@@ -395,23 +405,23 @@ let really_compare_programs backend comparison_tool log env =
           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.Same -> (Result.pass, env)
       | Filecompare.Different ->
         let reason = Printf.sprintf "Files %s and %s are different"
           program program2 in
-        Fail reason
+        (Result.fail_with_reason reason, env)
       | Filecompare.Unexpected_output -> assert false
       | Filecompare.Error (commandline, exitcode) ->
         let reason = Actions_helpers.mkreason what commandline exitcode in
-        Fail reason
+        (Result.fail_with_reason reason, env)
   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)";
+    let reason = "program comparison disabled" in
-    Pass env
+    (Result.pass_with_reason reason, env)
   end else really_compare_programs backend comparison_tool log env
 
 let make_bytecode_programs_comparison_tool ocamlsrcdir =
@@ -468,9 +478,13 @@ let compile_module
         ~stderr_variable:compileroutput
         ~append:true log env commandline in
     if exit_status=expected_exit_status
-    then Pass env
+    then (Result.pass, env)
-    else Fail (Actions_helpers.mkreason
+    else begin
-      what (String.concat " " commandline) exit_status) in
+      let reason =
+        (Actions_helpers.mkreason
+          what (String.concat " " commandline) exit_status) in
+      (Result.fail_with_reason reason, env)
+    end in
   match module_filetype with
     | Filetype.Interface ->
       let interface_name =
@@ -494,7 +508,7 @@ let compile_module
     | _ ->
       let reason = Printf.sprintf "File %s of type %s not supported yet"
         filename (Filetype.string_of_filetype module_filetype) in
-      (Fail reason)
+      (Result.fail_with_reason reason, env)
 
 let compile_modules
     ocamlsrcdir compiler compilername compileroutput
@@ -504,12 +518,11 @@ let compile_modules
     compile_module ocamlsrcdir compiler compilername compileroutput
     log env mod_ in
   let rec compile_mods env = function
-    | [] -> Pass env
+    | [] -> (Result.pass, env)
     | m::ms ->
-      (match compile_mod env m with
+      (let (result, newenv) = compile_mod env m in
-        | Fail _ | Skip _ as error -> error
+      if Result.is_pass result then (compile_mods newenv ms)
-        | Pass newenv -> (compile_mods newenv ms)
+      else (result, newenv)) in
-      ) in
   compile_mods initial_env modules_with_filetypes
 
 let run_test_program_in_toplevel toplevel log env =
@@ -524,43 +537,44 @@ let run_test_program_in_toplevel toplevel log env =
     | Sys.Other _ -> assert false in
   let compiler_name = compiler.Ocaml_compilers.name ocamlsrcdir in
   let modules_with_filetypes = List.map Filetype.filetype (modules env) in
-  let aux = compile_modules
+  let (modules_result, modules_env) = compile_modules
     ocamlsrcdir compiler compiler_name compiler_output_variable
     modules_with_filetypes log env in
-  match aux with
+  if Result.is_pass modules_result then begin
-    | Fail _ | Skip _ -> aux
+    let what =
-    | Pass auxenv ->
+      Printf.sprintf "Running %s in %s toplevel (expected exit status: %d)"
-      begin
+      testfile
-        let what =
+      (Ocaml_backends.string_of_backend toplevel.Ocaml_compilers.backend)
-          Printf.sprintf "Running %s in %s toplevel (expected exit status: %d)"
+      expected_exit_status in
-          testfile
+    Printf.fprintf log "%s\n%!" what;
-          (Ocaml_backends.string_of_backend toplevel.Ocaml_compilers.backend)
+    let toplevel_name = toplevel.Ocaml_compilers.name ocamlsrcdir in
-          expected_exit_status in
+    let toplevel_default_flags = "-noinit -no-version -noprompt" in
-        Printf.fprintf log "%s\n%!" what;
+    let commandline =
-        let toplevel_name = toplevel.Ocaml_compilers.name ocamlsrcdir in
+    [
-        let toplevel_default_flags = "-noinit -no-version -noprompt" in
+      toplevel_name;
-        let commandline =
+      toplevel_default_flags;
-        [
+      toplevel.Ocaml_compilers.flags;
-          toplevel_name;
+      Ocaml_flags.stdlib ocamlsrcdir;
-          toplevel_default_flags;
+      directory_flags modules_env;
-          toplevel.Ocaml_compilers.flags;
+      Ocaml_flags.include_toplevel_directory ocamlsrcdir;
-          Ocaml_flags.stdlib ocamlsrcdir;
+      flags modules_env;
-          directory_flags auxenv;
+    ] in
-          Ocaml_flags.include_toplevel_directory ocamlsrcdir;
+    let exit_status =
-          flags auxenv;
+      Actions_helpers.run_cmd
-        ] in
+        ~environment:dumb_term
-        let exit_status =
+        ~stdin_variable:Builtin_variables.test_file
-          Actions_helpers.run_cmd
+        ~stdout_variable:compiler_output_variable
-            ~environment:dumb_term
+        ~stderr_variable:compiler_output_variable
-            ~stdin_variable:Builtin_variables.test_file
+        log modules_env commandline in
-            ~stdout_variable:compiler_output_variable
+    if exit_status=expected_exit_status
-            ~stderr_variable:compiler_output_variable
+    then (Result.pass, modules_env)
-            log auxenv commandline in
+    else begin
-        if exit_status=expected_exit_status
+      let reason =
-        then Pass auxenv
+        (Actions_helpers.mkreason
-        else Fail (Actions_helpers.mkreason
+          what (String.concat " " commandline) exit_status) in
-          what (String.concat " " commandline) exit_status)
+      (Result.fail_with_reason reason, modules_env)
-      end
+    end
+  end else (modules_result, modules_env)
 
 let ocaml = Actions.make
   "ocaml"

ocamltest/result.ml

@@ -0,0 +1,57 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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 test-result related types and functions *)
+
+type status = Pass | Skip | Fail
+
+type t = {
+  status : status;
+  reason : string option
+}
+
+let result_of_status s = { status = s; reason = None }
+
+let pass = result_of_status Pass
+
+let skip = result_of_status Skip
+
+let fail = result_of_status Fail
+
+let result_with_reason s r = { status = s; reason = Some r }
+
+let pass_with_reason r = result_with_reason Pass r
+
+let skip_with_reason r = result_with_reason Skip r
+
+let fail_with_reason r = result_with_reason Fail r
+
+let string_of_status = function
+  | Pass -> "passed"
+  | Skip -> "skipped"
+  | Fail -> "failed"
+
+let string_of_reason = function
+  | None -> ""
+  | Some reason -> (" (" ^ reason ^ ")")
+
+let string_of_result r =
+  (string_of_status r.status) ^ (string_of_reason r.reason)
+
+let is_pass r = r.status = Pass
+
+let is_skip r = r.status = Skip
+
+let is_fail r = r.status = Fail

ocamltest/result.mli

@@ -0,0 +1,43 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2018 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 test-result related types and functions *)
+
+type status = Pass | Skip | Fail
+
+type t = {
+  status : status;
+  reason : string option
+}
+
+val pass : t
+
+val skip : t
+
+val fail : t
+
+val pass_with_reason : string -> t
+
+val skip_with_reason : string -> t
+
+val fail_with_reason : string -> t
+
+val string_of_result : t -> string
+
+val is_pass : t -> bool
+
+val is_skip : t -> bool
+
+val is_fail : t -> bool

ocamltest/tests.ml

@@ -51,25 +51,18 @@ let test_of_action action =
 let run_actions log testenv actions =
   let total = List.length actions in
   let rec run_actions_aux action_number env = function
-    | [] -> Actions.Pass env
+    | [] -> (Result.pass, env)
     | action::remaining_actions ->
       begin
         Printf.fprintf log "Running action %d/%d (%s)\n%!"
           action_number total (Actions.action_name action);
-        let result = Actions.run log env action in
+        let (result, env') = Actions.run log env action in
-        let report = match result with
-          | Actions.Pass _ -> "succeded."
-          | Actions.Fail reason ->
-            ("failed for the following reason:\n" ^ reason)
-          | 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 (Actions.action_name action)
-          report;
+          (Result.string_of_result result);
-        match result with
+        if Result.is_pass result
-          | Actions.Pass env' ->
+        then run_actions_aux (action_number+1) env' remaining_actions
-            run_actions_aux (action_number+1) env' remaining_actions
+        else (result, env')
-          | _ -> result
       end in
   run_actions_aux 1 testenv actions
 

ocamltest/tests.mli

@@ -31,7 +31,7 @@ val default_tests : unit -> t list
 
 val lookup : string -> t option
 
-val run : out_channel -> Environments.t -> t -> Actions.result
+val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
 
 val test_of_action : Actions.t -> t