ocamltest: show failing logs (#9696)

Changes

@@ -185,6 +185,11 @@ Working version
   naked-pointers and no-naked-pointers mode
   (Xavier Leroy and Gabriel Scherer)
 
+- #9696: ocamltest now shows its log when a test fails. In addition, the log
+  contains the output of executed programs.
+  (Nicolás Ojeda Bär, review by David Allsopp, Sébastien Hinderer and Gabriel
+  Scherer)
+
 ### Build system:
 
 - #9332, #9518, #9529: Cease storing C dependencies in the codebase. C

ocamltest/actions_helpers.ml

@@ -139,17 +139,29 @@ let run_cmd
       environment
       (Environments.to_system_env env)
   in
-  Run_command.run {
-    Run_command.progname = progname;
-    Run_command.argv = arguments;
-    Run_command.envp = systemenv;
-    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 n =
+    Run_command.run {
+      Run_command.progname = progname;
+      Run_command.argv = arguments;
+      Run_command.envp = systemenv;
+      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
+    }
+  in
+  let dump_file s fn =
+    if not (Sys.file_is_empty fn) then begin
+      Printf.fprintf log "### begin %s ###\n" s;
+      Sys.dump_file log fn;
+      Printf.fprintf log "### end %s ###\n" s
+    end
+  in
+  dump_file "stdout" stdout_filename;
+  if stdout_filename <> stderr_filename then dump_file "stderr" stderr_filename;
+  n
 
 let run
     (log_message : string)

ocamltest/main.ml

@@ -158,13 +158,14 @@ let test_file test_filename =
   in
   clean_test_build_directory ();
   Sys.make_directory test_build_directory_prefix;
+  let log_filename =
+    Filename.concat test_build_directory_prefix (test_prefix ^ ".log") in
+  let log =
+    if Options.log_to_stderr then stderr else begin
+      open_out log_filename
+    end in
   let summary = Sys.with_chdir test_build_directory_prefix
     (fun () ->
-       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 promote = string_of_bool Options.promote in
        let install_hook name =
          let hook_name = Filename.make_filename hookname_prefix name in
@@ -200,11 +201,13 @@ let test_file test_filename =
        let summary =
          run_test_trees log common_prefix "" initial_status test_trees in
        Actions.clear_all_hooks();
-       if not Options.log_to_stderr then close_out log;
        summary
     ) in
+  if not Options.log_to_stderr then close_out log;
   begin match summary with
-  | Some_failure -> ()
+  | Some_failure ->
+      if not Options.log_to_stderr then
+        Sys.dump_file stderr ~prefix:"> " log_filename
   | No_failure ->
       if not Options.keep_test_dir_on_success then
         clean_test_build_directory ()

ocamltest/ocamltest_stdlib.ml

@@ -107,6 +107,7 @@ module Sys = struct
       (fun () -> f ic)
 
   let file_is_empty filename =
+    not (Sys.file_exists filename) ||
     with_input_file filename in_channel_length = 0
 
   let string_of_file filename =
@@ -121,6 +122,19 @@ module Sys = struct
         failwith ("Got unexpected end of file while reading " ^ filename)
     end
 
+  let iter_lines_of_file f filename =
+    let rec go ic =
+      match input_line ic with
+      | exception End_of_file -> ()
+      | l -> f l; go ic
+    in
+    with_input_file filename go
+
+  let dump_file oc ?(prefix = "") filename =
+    let f s =
+      output_string oc prefix; output_string oc s; output_char oc '\n' in
+    iter_lines_of_file f filename
+
   let with_output_file ?(bin=false) x f =
     let oc = (if bin then open_out_bin else open_out) x in
     Fun.protect ~finally:(fun () -> close_out_noerr oc)

ocamltest/ocamltest_stdlib.mli

@@ -49,6 +49,8 @@ module Sys : sig
   val run_system_command : string -> string list -> unit
   val make_directory : string -> unit
   val string_of_file : string -> string
+  val iter_lines_of_file : (string -> unit) -> string -> unit
+  val dump_file : out_channel -> ?prefix:string -> string -> unit
   val copy_chan : in_channel -> out_channel -> unit
   val copy_file : string -> string -> unit
   val force_remove : string -> unit

ocamltest/tests.ml

@@ -54,7 +54,7 @@ let run_actions log testenv actions =
     | [] -> (Result.pass, env)
     | action::remaining_actions ->
       begin
-        Printf.fprintf log "Running action %d/%d (%s)\n%!"
+        Printf.fprintf log "\nRunning action %d/%d (%s)\n%!"
           action_number total (Actions.name action);
         let (result, env') = Actions.run log env action in
         Printf.fprintf log "Action %d/%d (%s) %s\n%!"

testsuite/summarize.awk

@@ -70,6 +70,10 @@ function record_unexp() {
     clear();
 }
 
+/^> / {
+    next;
+}
+
 /Running tests from '[^']*'/ {
     if (in_test) record_unexp();
     match($0, /Running tests from '[^']*'/);