Add a --output/-o option to specify mdx test output

CHANGES.md

@@ -2,6 +2,8 @@
 
 #### Added
 
+- Add a `--output`/`-o` option to the `test` subcommand to allow specifying a different
+  output file to write the corrected to, or to write it to the standard output (#194, @NathanReb)
 - Migrate to OCaml 4.08 AST to add support for `let*` bindings (#190, @gpetiot)
 - Add `--syntax` option to `rule` subcommand to allow generating rules for cram
   tests (#177, @craigfe)

bin/cli.ml

@@ -25,10 +25,12 @@ let syntax =
   named (fun x -> `Syntax x)
     Arg.(value & opt (some syntax) None & info ["syntax"] ~doc ~docv:"SYNTAX")
 
+let file_docv = "FILE"
+
 let file =
   let doc = "The file to use." in
   named (fun x -> `File x)
-    Arg.(required & pos 0 (some string) None & info [] ~doc ~docv:"FILE")
+    Arg.(required & pos 0 (some string) None & info [] ~doc ~docv:file_docv)
 
 let section =
   let doc =
@@ -100,6 +102,36 @@ let force_output =
   named (fun x -> `Force_output x)
     Arg.(value & flag & info ["force-output"] ~doc)
 
+type output =
+  | File of string
+  | Stdout
+
+let output_conv =
+  let (sparse, sprint) = Arg.string in
+  let parse s =
+    match sparse s with
+    | `Ok "-" -> Ok Stdout
+    | `Ok s -> Ok (File s)
+    | `Error msg -> Error (`Msg msg)
+  in
+  let print fmt = function
+    | Stdout -> sprint fmt "-"
+    | File s -> sprint fmt s
+  in
+  Arg.conv ~docv:"OUTPUT" (parse, print)
+
+let output =
+  let docv = "OUTPUT" in
+  let doc =
+    Printf.sprintf
+      "Specify where to write the command output. $(docv) should be $(b,-) for \
+       stdout or a filename. Defaults to $(i,%s).corrected. \
+       Note that setting the output to stdout implies $(b,--force-output)."
+      file_docv
+  in
+  named (fun x -> `Output x)
+    Arg.(value & opt (some output_conv) None & info ~doc ~docv ["o"; "output"])
+
 let setup_log style_renderer level =
   Fmt_tty.setup_std_outputs ?style_renderer ();
   Logs.set_level level;

bin/cli.mli

@@ -24,4 +24,14 @@ val direction: [> `Direction of [ `To_md | `To_ml ] ] t
 
 val force_output: [> `Force_output of bool ] t
 
+type output =
+  | File of string
+  | Stdout
+
+(** A --output option to overwrite the command output.
+    One can pass it ["-"] to set it to stdout which should imply [force_output].
+    [default_doc] is used to describe the default value in the command's
+    manpage *)
+val output: [> `Output of output option] t
+
 val setup: [> `Setup of unit ] t

bin/test.ml

@@ -41,5 +41,6 @@ let cmd: int Term.t * Term.info =
   Term.(pure run
         $ Cli.setup $ Cli.non_deterministic $ Cli.not_verbose $ Cli.syntax
         $ Cli.silent $ Cli.verbose_findlib $ Cli.prelude $ Cli.prelude_str
-        $ Cli.file $ Cli.section $ Cli.root $ Cli.direction $ Cli.force_output),
+        $ Cli.file $ Cli.section $ Cli.root $ Cli.direction $ Cli.force_output
+        $ Cli.output),
   Term.info "test" ~doc

bin/test/main.ml

@@ -266,7 +266,7 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic)
     (`Not_verbose not_verbose) (`Syntax syntax) (`Silent silent)
     (`Verbose_findlib verbose_findlib) (`Prelude prelude)
     (`Prelude_str prelude_str) (`File file) (`Section section) (`Root root)
-    (`Direction direction) (`Force_output force_output) =
+    (`Direction direction) (`Force_output force_output) (`Output output) =
   let c =
     Mdx_top.init ~verbose:(not not_verbose) ~silent ~verbose_findlib ()
   in
@@ -353,25 +353,33 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic)
       | None ->
         run_toplevel_tests ?root c ppf tests t
   in
-
-  Mdx.run ?syntax ~force_output file ~f:(fun file_contents items ->
-      let temp_file = Filename.temp_file "ocaml-mdx" ".output" in
-      at_exit (fun () -> Sys.remove temp_file);
-      let buf = Buffer.create (String.length file_contents + 1024) in
-      let ppf = Format.formatter_of_buffer buf in
-      List.iter (function
-          | Section _
-          | Text _ as t -> Mdx.pp_line ?syntax ppf t
-          | Block t ->
-            List.iter (fun (k, v) -> Unix.putenv k v) (Block.set_variables t);
-            try
-              Mdx_top.in_env (Block.environment t)
-                (fun () -> test_block ~ppf ~temp_file t)
-            with Failure msg ->
-              raise (Test_block_failure (t, msg))
-        ) items;
-      Format.pp_print_flush ppf ();
-      Buffer.contents buf);
+  let _ = Misc.remove_file in
+  let gen_expected file_contents items =
+    let temp_file = Filename.temp_file "ocaml-mdx" ".output" in
+    at_exit (fun () -> Sys.remove temp_file);
+    let buf = Buffer.create (String.length file_contents + 1024) in
+    let ppf = Format.formatter_of_buffer buf in
+    List.iter (function
+        | Section _
+        | Text _ as t -> Mdx.pp_line ?syntax ppf t
+        | Block t ->
+          List.iter (fun (k, v) -> Unix.putenv k v) (Block.set_variables t);
+          try
+            Mdx_top.in_env (Block.environment t)
+              (fun () -> test_block ~ppf ~temp_file t)
+          with Failure msg ->
+            raise (Test_block_failure (t, msg))
+      ) items;
+    Format.pp_print_flush ppf ();
+    Buffer.contents buf
+  in
+  let run_to_file outfile =
+    Mdx.run_to_file ?syntax ~force_output ~outfile ~f:gen_expected file
+  in
+  (match (output : Cli.output option) with
+   | Some Stdout -> Mdx.run_to_stdout ?syntax ~f:gen_expected file
+   | Some (File outfile) -> run_to_file outfile
+   | None -> run_to_file (file ^ ".corrected"));
   Hashtbl.iter (write_parts ~force_output) files;
   0
 
@@ -387,10 +395,10 @@ let report_error_in_block block msg =
     kind block.file block.line msg
 
 let run setup non_deterministic not_verbose syntax silent verbose_findlib
-    prelude prelude_str file section root direction force_output : int =
+    prelude prelude_str file section root direction force_output output : int =
     try
     run_exn setup non_deterministic not_verbose syntax silent verbose_findlib
-      prelude prelude_str file section root direction force_output
+      prelude prelude_str file section root direction force_output output
     with
     | Failure f ->
       prerr_endline f;
@@ -410,7 +418,8 @@ let cmd =
   Term.(pure run
         $ Cli.setup $ Cli.non_deterministic $ Cli.not_verbose $ Cli.syntax
         $ Cli.silent $ Cli.verbose_findlib $ Cli.prelude $ Cli.prelude_str
-        $ Cli.file $ Cli.section $ Cli.root $ Cli.direction $ Cli.force_output),
+        $ Cli.file $ Cli.section $ Cli.root $ Cli.direction $ Cli.force_output
+        $ Cli.output),
   Term.info "ocaml-mdx-test" ~version:"%%VERSION%%" ~doc ~exits ~man
 
 let main () = Term.(exit_status @@ eval cmd)

lib/mdx.ml

@@ -84,10 +84,34 @@ let eval = function
     let t' = Block.eval t in
     if t == t' then x else Block t'
 
-let run ?(syntax=Normal) ?(force_output=false) ~f n =
-  Misc.run_expect_test ~force_output n ~f:(fun c l ->
-      let items = parse_lexbuf syntax l in
-      let items = List.map eval items in
-      Log.debug (fun l -> l "run @[%a@]" dump items);
-      f c items
-    )
+type expect_result =
+  | Identical
+  | Differs
+
+let run_str ~syntax ~f file =
+  let file_contents, lexbuf = Misc.init file in
+  let items = parse_lexbuf syntax lexbuf in
+  let items = List.map eval items in
+  Log.debug (fun l -> l "run @[%a@]" dump items);
+  let expected = f file_contents items in
+  let result = if expected <> file_contents then Differs else Identical in
+  (result, expected)
+
+let run_to_file ?(syntax=Normal) ?(force_output=false) ~f ~outfile infile =
+  let (test_result, expected) = run_str ~syntax ~f infile in
+  match force_output, test_result with
+  | true, _
+  | false, Differs ->
+    let oc = open_out_bin outfile in
+    output_string oc expected;
+    close_out oc
+  | false, Identical ->
+    if Sys.file_exists outfile then Sys.remove outfile
+
+let run_to_stdout ?(syntax=Normal) ~f infile =
+  let (_, expected) = run_str ~syntax ~f infile in
+  print_string expected
+
+let run ?(syntax=Normal) ?(force_output=false) ~f infile =
+  let outfile = infile ^ ".corrected" in
+  run_to_file ~syntax ~force_output ~f ~outfile infile

lib/mdx.mli

@@ -69,6 +69,16 @@ val parse_lexbuf: syntax -> Lexing.lexbuf -> t
 
 (** {2 Evaluation} *)
 
+val run_to_stdout : ?syntax: syntax -> f:(string -> t -> string) -> string -> unit
+
+val run_to_file :
+  ?syntax: syntax ->
+  ?force_output: bool ->
+  f:(string -> t -> string) ->
+  outfile: string ->
+  string ->
+  unit
+
 val run: ?syntax:syntax -> ?force_output:bool -> f:(string -> t -> string) -> string -> unit
 (** [run ?syntax ~f n] runs the expect callback [f] over the file named
    [n]. [f] is called with the raw contents of [n] and its structured

lib/misc.ml

@@ -48,18 +48,6 @@ let init file =
     };
   file_contents, lexbuf
 
-let run_expect_test ~force_output file ~f =
-  let file_contents, lexbuf = init file in
-  let expected = f file_contents lexbuf in
-  let corrected_file = file ^ ".corrected" in
-  if force_output || file_contents <> expected then begin
-    let oc = open_out_bin corrected_file in
-    output_string oc expected;
-    close_out oc;
-  end else begin
-    if Sys.file_exists corrected_file then Sys.remove corrected_file
-  end
-
 let pp_position ppf lexbuf =
   let p = Lexing.lexeme_start_p lexbuf in
   Fmt.pf ppf

test/bin/test-output-option/dune

@@ -0,0 +1,37 @@
+(rule
+ (target std-out.corrected)
+ (deps (package mdx) (:md test-case.md))
+ (action
+  (with-stdout-to %{target}
+   (run ocaml-mdx test --output - %{md}))))
+
+(alias
+ (name runtest)
+ (deps
+  (:expected test-case.md)
+  (:actual std-out.corrected))
+ (action (diff %{expected} %{actual})))
+
+(rule
+ (target explicit-outfile.corrected)
+ (deps (package mdx) (:md test-case.md))
+ (action (run ocaml-mdx test --force-output --output %{target} %{md})))
+
+(alias
+ (name runtest)
+ (deps
+  (:expected test-case.md)
+  (:actual explicit-outfile.corrected))
+ (action (diff %{expected} %{actual})))
+
+(rule
+ (target test-case.md.corrected)
+ (deps (package mdx) (:md test-case.md))
+ (action (run ocaml-mdx test --force-output %{md})))
+
+(alias
+ (name runtest)
+ (deps
+  (:expected test-case.md)
+  (:actual test-case.md.corrected))
+ (action (diff %{expected} %{actual})))

test/bin/test-output-option/test-case.md

@@ -0,0 +1,11 @@
+`mdx-test` output can be configured via the `--output`/`-o` CLI option. It can be used to write
+to a file or to stdout by passing `--output -`.
+
+When not specified, it should default to `<input_file>.corrected`.
+
+Check the dune file in this folder to see the actual tests!
+
+```ocaml
+# let x = 1 + 1;;
+val x : int = 2
+```