Implement and expose stash_output_file(s)

Author: mjambon

core/Store.ml

@@ -639,6 +639,10 @@ let with_result_capture (test : T.test) func : unit -> unit Promise.t =
 let mark_test_as_timed_out (test : T.test) =
   set_completion_status test Test_timeout
 
+let stash_output_file (test : T.test) src_path (x : T.checked_output_file) : unit =
+  let dst_path = get_output_file_path test x in
+  Helpers.copy_file src_path dst_path
+
 (**************************************************************************)
 (* High-level interface *)
 (**************************************************************************)

core/Store.mli

@@ -117,6 +117,9 @@ val remove_dead_snapshot : dead_snapshot -> unit
    that worker doesn't try to write another status at the same time. *)
 val mark_test_as_timed_out : Types.test -> unit
 
+(* Copy a checked output file identified by its unique name (not its path) *)
+val stash_output_file : Types.test -> Fpath.t -> Types.checked_output_file -> unit
+
 (**************************************************************************)
 (* User-facing utilities *)
 (**************************************************************************)

core/Testo.ml

@@ -144,6 +144,23 @@ let checked_output_file ?snapshot_path name : checked_output_file =
     options = { snapshot_path };
   }
 
+let stash_output_file src_path name =
+  match Run.get_current_test () with
+  | None ->
+      failwith "Testo.stash_output_file is being called outside of a test"
+  | Some test ->
+      match List.find_opt (fun (x : T.checked_output_file) -> x.name = name)
+              test.checked_output_files with
+      | None ->
+          invalid_arg (
+            sprintf
+              "Testo.stash_output_file: invalid output file name \
+               for test '%s': '%s'"
+              test.name name
+          )
+      | Some x ->
+          Store.stash_output_file test src_path x
+
 (*
    Create an hexadecimal hash that is just long enough to not suffer from
    collisions in realistic use cases defined as:
@@ -227,14 +244,8 @@ let fail = Testo_util.Error.fail_test
 
 let write_file = Helpers.write_file
 let read_file = Helpers.read_file
-
-let map_file func src_path dst_path =
-  let old_contents = read_file src_path in
-  let new_contents = func old_contents in
-  write_file dst_path new_contents
-
-let copy_file src_path dst_path =
-  map_file (fun data -> data) src_path dst_path
+let map_file = Helpers.map_file
+let copy_file = Helpers.copy_file
 
 let with_temp_file = Temp_file.with_temp_file
 let with_capture = Store.with_capture
@@ -247,12 +258,9 @@ let with_chdir path func =
     func
 
 (* We need this to allow the user's test function to call
-   'stash_output_files' *)
+   'stash_output_file' *)
 let get_current_test () = Run.get_current_test ()
 
-(* TODO: stash_output_files: copy the output files to compare against
-   snapshots before cleaning up the workspace *)
-
 (**************************************************************************)
 (* Hygiene *)
 (**************************************************************************)

core/Testo.mli

@@ -129,6 +129,15 @@ val checked_output_file :
     the snapshot file that serves as the expectation for future test runs.
 *)
 
+val stash_output_file : Fpath.t -> string -> unit
+(** [stash_output_file src_path dst_name] copies a checked output file
+    of the current test identified by its name [dst_name]
+    into Testo's status workspace.
+
+    This function must be called by the test function for each checked
+    output file.
+*)
+
 module Promise : module type of Promise
 (** Wrapper allowing for asynchronous test functions (Lwt and such). *)
 

util/lib/Helpers.ml

@@ -111,3 +111,11 @@ let read_file path =
       let len = in_channel_length ic in
       really_input_string ic len)
     ~finally:(fun () -> close_in_noerr ic)
+
+let map_file func src_path dst_path =
+  let old_contents = read_file src_path in
+  let new_contents = func old_contents in
+  write_file dst_path new_contents
+
+let copy_file src_path dst_path =
+  map_file (fun data -> data) src_path dst_path

util/lib/Helpers.mli

@@ -26,3 +26,5 @@ val contains_pcre_pattern : pat:string -> string -> bool
 val contains_substring : sub:string -> string -> bool
 val write_file : Fpath.t -> string -> unit
 val read_file : Fpath.t -> string
+val map_file : (string -> string) -> Fpath.t -> Fpath.t -> unit
+val copy_file : Fpath.t -> Fpath.t -> unit