ocamltest: add support for using strace

ocamltest/.depend

@@ -36,6 +36,7 @@ actions.cmi : \
     environments.cmi
 actions_helpers.cmo : \
     variables.cmi \
+    strace.cmi \
     run_command.cmi \
     result.cmi \
     ocamltest_stdlib.cmi \
@@ -47,6 +48,7 @@ actions_helpers.cmo : \
     actions_helpers.cmi
 actions_helpers.cmx : \
     variables.cmx \
+    strace.cmx \
     run_command.cmx \
     result.cmx \
     ocamltest_stdlib.cmx \
@@ -391,6 +393,14 @@ run_command.cmx : \
     ocamltest_stdlib.cmx \
     run_command.cmi
 run_command.cmi :
+strace.cmo : \
+    variables.cmi \
+    strace.cmi
+strace.cmx : \
+    variables.cmx \
+    strace.cmi
+strace.cmi : \
+    variables.cmi
 tests.cmo : \
     result.cmi \
     actions.cmi \

ocamltest/Makefile

@@ -100,6 +100,7 @@ core := \
   result.mli result.ml \
   actions.mli actions.ml \
   tests.mli tests.ml \
+  strace.mli strace.ml \
   tsl_ast.mli tsl_ast.ml \
   tsl_parser.mly \
   tsl_lexer.mli tsl_lexer.mll \

ocamltest/actions_helpers.ml

@@ -97,13 +97,29 @@ let run_cmd
     ?(stderr_variable=Builtin_variables.stderr)
     ?(append=false)
     ?(timeout=0)
-    log env cmd
+    log env original_cmd
   =
   let log_redirection std filename =
     if filename<>"" then
     begin
       Printf.fprintf log "  Redirecting %s to %s \n%!" std filename
     end in
+  let cmd =
+    if (Environments.lookup_as_bool Strace.strace env) = Some true then
+    begin
+      let action_name = Environments.safe_lookup Actions.action_name env in
+      let test_build_directory = test_build_directory env in
+      let strace_logfile_name = Strace.get_logfile_name action_name in
+      let strace_logfile =
+        Filename.make_path [test_build_directory; strace_logfile_name]
+      in
+      let strace_flags = Environments.safe_lookup Strace.strace_flags env in
+      let strace_cmd =
+        ["strace -f -o"; strace_logfile; strace_flags]
+      in
+      strace_cmd @ original_cmd
+    end else original_cmd
+  in
   let lst = List.concat (List.map String.words cmd) in
   let quoted_lst =
     if Sys.os_type="Win32"

ocamltest/strace.ml

@@ -0,0 +1,32 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Implementation of the strace feature *)
+
+let strace = Variables.make ("strace", "Whether to use strace")
+let strace_flags =
+  Variables.make ("strace_flags", "Which flags to pass to strace")
+
+let (counters : (string, int) Hashtbl.t) = Hashtbl.create 10
+
+let get_logfile_name base =
+  let n = try Hashtbl.find counters base with Not_found -> 1 in
+  let filename = Printf.sprintf "strace-%s_%d.log" base n in
+  Hashtbl.add counters base (n+1);
+  filename
+
+let _ =
+  Variables.register_variable strace;
+  Variables.register_variable strace_flags

ocamltest/strace.mli

@@ -0,0 +1,22 @@
+(**************************************************************************)
+(*                                                                        *)
+(*                                 OCaml                                  *)
+(*                                                                        *)
+(*             Sebastien Hinderer, projet Gallium, INRIA Paris            *)
+(*                                                                        *)
+(*   Copyright 2019 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.          *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* Interface to the strace feature *)
+
+val strace : Variables.t
+
+val strace_flags : Variables.t
+
+val get_logfile_name : string -> string