flambda-backend: Resolve conflicts in ocamltest (ocaml-flambda#2805)

* Resolve conflicts in ocamltest

* Restore the "do_something" mechanism.

* Further fixes for ocamltest

---------

Co-authored-by: Xavier Clerc <xclerc@janestreet.com>

ocamltest/OCAMLTEST.org

@@ -581,19 +581,9 @@ namely:
 *)
 #+end_src
 
-<<<<<<< HEAD:ocamltest/ocamltest.org
-The braces make explicit the scope of variable assignments: an
-assignement modifies a variable for the rest of its block and for all
-sub-blocks (unless overridden at some point).
-||||||| 121bedcfd2:ocamltest/ocamltest.org
-The fact that the language is inspired by org-mode should also be
-helpful in understanding the scope of variable assignments. Roughly
-speaking:
-=======
 The braces make explicit the scope of variable assignments: an
 assignment modifies a variable for the rest of its block and for all
 sub-blocks (unless overridden at some point).
->>>>>>> 5.2.0:ocamltest/OCAMLTEST.org
 
 For instance, given the following blocks:
 #+begin_src

ocamltest/actions.ml

@@ -80,4 +80,4 @@ module ActionSet = Set.Make
   let compare = compare
 end)
 
-let _ = Variables.register_variable action_name
+let init () = Variables.register_variable action_name

ocamltest/actions.mli

@@ -47,3 +47,5 @@ val run : out_channel -> Environments.t -> t -> Result.t * Environments.t
 val does_something : t -> bool
 
 module ActionSet : Set.S with type elt = t
+
+val init : unit -> unit

ocamltest/builtin_actions.ml

@@ -245,7 +245,6 @@ let frame_pointers = make
      "frame-pointers available"
      "frame-pointers not available")
 
-<<<<<<< HEAD
 let probes = make
   ~name:"probes"
   ~description:"Pass if probes are available"
@@ -262,23 +261,22 @@ let naked_pointers = make
      "Runtime system supports naked pointers"
      "Runtime system does not support naked pointers")
 
-||||||| 121bedcfd2
-=======
 let tsan = make
   ~name:"tsan"
   ~description:"Pass if thread sanitizer is supported"
-  (Actions_helpers.pass_or_skip (Ocamltest_config.tsan)
+  ~does_something:false
+  (Actions_helpers.predicate (Ocamltest_config.tsan)
      "tsan available"
      "tsan not available")
 
 let no_tsan = make
   ~name:"no-tsan"
   ~description:"Pass if thread sanitizer is not supported"
-  (Actions_helpers.pass_or_skip (not Ocamltest_config.tsan)
+  ~does_something:false
+  (Actions_helpers.predicate (not Ocamltest_config.tsan)
      "tsan not available"
      "tsan available")
 
->>>>>>> 5.2.0
 let has_symlink = make
   ~name:"has_symlink"
   ~description:"Pass if symbolic links are available"
@@ -386,7 +384,7 @@ let initialize_test_exit_status_variables _log env =
     Builtin_variables.test_skip, "125";
   ] env
 
-let _ =
+let init () =
   Environments.register_initializer Environments.Post
     "test_exit_status_variables" initialize_test_exit_status_variables;
   List.iter register
@@ -425,12 +423,7 @@ let _ =
     naked_pointers;
     file_exists;
     copy;
-<<<<<<< HEAD
     probes;
-    naked_pointers
-||||||| 121bedcfd2
-=======
     tsan;
     no_tsan;
->>>>>>> 5.2.0
   ]

ocamltest/builtin_actions.mli

@@ -51,3 +51,5 @@ val check_program_output : Actions.t
 val file_exists : Actions.t
 
 val copy : Actions.t
+
+val init : unit -> unit

ocamltest/builtin_variables.ml

@@ -114,7 +114,8 @@ let test_fail = Variables.make ("TEST_FAIL",
 let timeout = Variables.make ("timeout",
   "Maximal execution time for every command (in seconds)")
 
-let _ = List.iter Variables.register_variable
+let init () =
+  List.iter Variables.register_variable
   [
     arguments;
     cwd;

ocamltest/builtin_variables.mli

@@ -75,3 +75,5 @@ val test_skip : Variables.t
 val test_fail : Variables.t
 
 val timeout : Variables.t
+
+val init : unit -> unit

ocamltest/dune

@@ -22,25 +22,6 @@
 
 ;; FIXME: handle UNIX_OR_WIN32 or something similar
 
-(library
- (name ocamltest_core_and_plugin)
- (modes byte)
- (wrapped false)
- ; -linkall so we don't fail to include e.g. ocaml_modifiers.ml, which only
- ; has top-level side effects.
- (flags
-  (:standard -linkall -w +a-40-41-42-44-70))
- (libraries ocamlcommon unix)
- (modules
-  (:standard \ options main ocamltest_unix_dummy ocamltest_unix_real))
- (foreign_stubs
-  (language c)
-  (names run_unix run_stubs)
-  (flags
-   ((-DCAML_INTERNALS)
-    (:include %{project_root}/oc_cflags.sexp)
-    (:include %{project_root}/oc_cppflags.sexp)))))
-
 (rule
  (targets empty.ml)
  (deps
@@ -50,15 +31,25 @@
 
 (executable
  (name main)
- (modes byte)
+ (modes native)
  (flags
   (:standard
    -w
    +a-40-41-42-44-70
    -cclib
    "-I../%{env:RUNTIME_DIR=runtime-dir-env-var-not-set}"))
- (modules options main)
- (libraries ocamltest_core_and_plugin))
+ (libraries ocamlcommon)
+ ; This executable is built using the *system* compiler, so we can't use
+ ; our own otherlibs/unix/, and neither can we depend on the "unix" library
+ ; or this same one will be used.
+ (ocamlopt_flags unix.cmxa)
+ (foreign_stubs
+  (language c)
+  (names run_unix run_stubs)
+  (flags
+   ((-DCAML_INTERNALS)
+    (:include %{project_root}/oc_cflags.sexp)
+    (:include %{project_root}/oc_cppflags.sexp)))))
 
 (rule
- (copy main.exe ocamltest.byte))
+ (copy main.exe ocamltest.native))

ocamltest/main.ml

@@ -20,49 +20,16 @@ open Tsl_ast
 open Tsl_semantics
 
 type behavior =
-<<<<<<< HEAD
-  | Skip_all_tests
-  | Run of Environments.t
-
-||||||| 121bedcfd2
-  | Skip_all_tests
-  | Run of Environments.t
-
-(*
-let first_token filename =
-  let input_channel = open_in filename in
-  let lexbuf = Lexing.from_channel input_channel in
-  Location.init lexbuf filename;
-  let token =
-    try Tsl_lexer.token lexbuf with e -> close_in input_channel; raise e
-  in close_in input_channel; token
-
-let is_test filename =
-  match first_token filename with
-    | exception _ -> false
-    | Tsl_parser.TSL_BEGIN_C_STYLE | TSL_BEGIN_OCAML_STYLE -> true
-    | _ -> false
-*)
-
-=======
   | Skip_all
   | Run
 
->>>>>>> 5.2.0
 (* this primitive announce should be used for tests
    that were aborted on system error before ocamltest
    could parse them *)
 let announce_test_error test_filename error =
   Printf.printf " ... testing '%s' => unexpected error (%s)\n%!"
     (Filename.basename test_filename) error
 
-<<<<<<< HEAD
-exception Syntax_error of Lexing.position
-
-let tsl_parse_file test_filename =
-||||||| 121bedcfd2
-let tsl_block_of_file test_filename =
-=======
 let print_exn loc e =
   let open Printf in
   let locstring =
@@ -92,7 +59,6 @@ let print_exn loc e =
 exception Syntax_error of Lexing.position
 
 let tsl_parse_file test_filename =
->>>>>>> 5.2.0
   let input_channel = open_in test_filename in
   let lexbuf = Lexing.from_channel input_channel in
   Location.init lexbuf test_filename;
@@ -141,7 +107,6 @@ let join_summaries sa sb =
   | No_failure, (No_failure | All_skipped)
   | All_skipped, No_failure -> No_failure
 
-<<<<<<< HEAD
 let rec run_test_tree log common_prefix behavior env summ ast =
   match ast with
   | Ast (Environment_statement s :: stmts, subs) ->
@@ -155,16 +120,22 @@ let rec run_test_tree log common_prefix behavior env summ ast =
       Some_failure
     end
   | Ast (Test (_, name, mods) :: stmts, subs) ->
+    let skip_all =
+      match behavior with
+      | Skip_all -> true
+      | Run -> false
+    in
     let locstr =
       if name.loc = Location.none then
         "default"
       else
         Printf.sprintf "line %d" name.loc.Location.loc_start.Lexing.pos_lnum
     in
-    Printf.printf "%s %s (%s) %!" common_prefix locstr name.node;
+    if not skip_all then
+      Printf.printf "%s %s (%s) %!" common_prefix locstr name.node;
     let (msg, children_behavior, newenv, result) =
       match behavior with
-      | Skip_all -> ("=> n/a", Skip_all, env, Result.skip)
+      | Skip_all -> ("", Skip_all, env, Result.skip)
       | Run ->
         begin try
           let testenv = List.fold_left apply_modifiers env mods in
@@ -176,72 +147,13 @@ let rec run_test_tree log common_prefix behavior env summ ast =
         with e -> (report_error name.loc e, Skip_all, env, Result.fail)
         end
     in
-    Printf.printf "%s\n%!" msg;
+    if not skip_all then Printf.printf "%s\n%!" msg;
     let newsumm = join_result summ result in
     let newast = Ast (stmts, subs) in
     run_test_tree log common_prefix children_behavior newenv newsumm newast
   | Ast ([], subs) ->
     List.fold_left join_summaries summ
       (List.map (run_test_tree log common_prefix behavior env All_skipped) subs)
-||||||| 2572783060
-let rec run_test log common_prefix path behavior = function
-  Node (testenvspec, test, env_modifiers, subtrees) ->
-  Printf.printf "%s %s (%s) %!" common_prefix path test.Tests.test_name;
-  let (msg, children_behavior, result) = match behavior with
-    | Skip_all_tests -> "=> n/a", Skip_all_tests, Result.skip
-    | Run env ->
-      let testenv0 = interpret_environment_statements env testenvspec in
-      let testenv = List.fold_left apply_modifiers testenv0 env_modifiers in
-      let (result, newenv) = Tests.run log testenv test in
-      let msg = Result.string_of_result result in
-      let children_behavior =
-        if Result.is_pass result then Run newenv else Skip_all_tests in
-      (msg, children_behavior, result) in
-  Printf.printf "%s\n%!" msg;
-  join_result
-    (run_test_trees log common_prefix path children_behavior subtrees) result
-
-and run_test_trees log common_prefix path behavior trees =
-  List.fold_left join_summaries All_skipped
-    (List.mapi (run_test_i log common_prefix path behavior) trees)
-
-and run_test_i log common_prefix path behavior i test_tree =
-  let path_prefix = if path="" then "" else path ^ "." in
-  let new_path = Printf.sprintf "%s%d" path_prefix (i+1) in
-  run_test log common_prefix new_path behavior test_tree
-=======
-let rec run_test log common_prefix path behavior = function
-  Node (testenvspec, test, env_modifiers, subtrees) ->
-  let skip_all =
-    match behavior with
-    | Skip_all_tests -> true
-    | Run _ -> false
-  in
-  if not skip_all then
-    Printf.printf "%s %s (%s) %!" common_prefix path test.Tests.test_name;
-  let (msg, children_behavior, result) = match behavior with
-    | Skip_all_tests -> "", Skip_all_tests, Result.skip
-    | Run env ->
-      let testenv0 = interpret_environment_statements env testenvspec in
-      let testenv = List.fold_left apply_modifiers testenv0 env_modifiers in
-      let (result, newenv) = Tests.run log testenv test in
-      let msg = Result.string_of_result result in
-      let children_behavior =
-        if Result.is_pass result then Run newenv else Skip_all_tests in
-      (msg, children_behavior, result) in
-  if not skip_all then Printf.printf "%s\n%!" msg;
-  join_result
-    (run_test_trees log common_prefix path children_behavior subtrees) result
-
-and run_test_trees log common_prefix path behavior trees =
-  List.fold_left join_summaries All_skipped
-    (List.mapi (run_test_i log common_prefix path behavior) trees)
-
-and run_test_i log common_prefix path behavior i test_tree =
-  let path_prefix = if path="" then "" else path ^ "." in
-  let new_path = Printf.sprintf "%s%d" path_prefix (i+1) in
-  run_test log common_prefix new_path behavior test_tree
->>>>>>> ocaml-jst/flambda-patches
 
 let get_test_source_directory test_dirname =
   if (Filename.is_relative test_dirname) then
@@ -269,22 +181,10 @@ let extract_rootenv (Ast (stmts, subs)) =
 let test_file test_filename =
   let start = if Options.show_timings then Unix.gettimeofday () else 0.0 in
   let skip_test = List.mem test_filename !tests_to_skip in
-<<<<<<< HEAD
-  let tsl_ast = tsl_parse_file_safe test_filename in
-  let (rootenv_statements, test_trees) = test_trees_of_tsl_ast tsl_ast in
-  let test_trees = match test_trees with
-    | [] ->
-||||||| 121bedcfd2
-  let tsl_block = tsl_block_of_file_safe test_filename in
-  let (rootenv_statements, test_trees) = test_trees_of_tsl_block tsl_block in
-  let test_trees = match test_trees with
-    | [] ->
-=======
   let tsl_ast = tsl_parse_file_safe test_filename in
   let (rootenv_statements, tsl_ast) = extract_rootenv tsl_ast in
-  let tsl_ast = match tsl_ast with
+  let tsl_ast = match[@ocaml.warning "-fragile-match"] tsl_ast with
     | Ast ([], []) ->
->>>>>>> 5.2.0
       let default_tests = Tests.default_tests() in
       let make_tree test =
         let id = make_identifier test.Tests.test_name in
@@ -434,6 +334,14 @@ let list_tests dir =
   sort_strings !res
 
 let () =
+  Actions.init ();
+  Builtin_actions.init ();
+  Builtin_variables.init ();
+  Ocaml_actions.init ();
+  Ocaml_modifiers.init ();
+  Ocaml_tests.init ();
+  Ocaml_variables.init ();
+  Strace.init ();
   init_tests_to_skip()
 
 let () =

ocamltest/ocaml_actions.ml

@@ -732,7 +732,7 @@ let run_codegen log env =
   let env = Environments.add Builtin_variables.output output env in
   let commandline =
   [
-    Ocaml_commands.ocamlrun_codegen;
+    Ocaml_commands.codegen;
     flags env;
     "-S " ^ testfile
   ] in
@@ -812,7 +812,7 @@ let run_expect_once input_file principal log env =
   let principal_flag = if principal then "-principal" else "" in
   let commandline =
   [
-    Ocaml_commands.ocamlrun_expect;
+    Ocaml_commands.expect;
     expect_flags;
     Ocaml_flags.toplevel_default_flags;
     Ocaml_flags.stdlib;
@@ -1513,7 +1513,7 @@ let run_ocamldoc =
     (Result.fail_with_reason reason, env)
   end
 
-let _ =
+let init () =
   Environments.register_initializer Environments.Post
     "find_source_modules" find_source_modules;
   Environments.register_initializer Environments.Pre