Improve error reporting of ocaml-mdx test

CHANGES.md

@@ -9,6 +9,7 @@
 
 - Remove trailing whitespaces at the end of toplevel or bash evaluation lines
   (#166, @clecat)
+- Improve error reporting of ocaml-mdx test (#172, @Julow)
 - Rule: Pass the --section option to `test` (#176, @Julow)
 
 #### Removed

bin/test/main.ml

@@ -199,10 +199,12 @@ let has_changed ~force_output { first; current } =
 let read_parts file =
   try Hashtbl.find files file
   with Not_found ->
-    let parts = Mdx_top.Part.read file in
-    let f = { first=parts; current=parts} in
-    Hashtbl.add files file f;
-    f
+    match Mdx_top.Part.read file with
+    | exception Sys_error msg -> failwith msg
+    | parts ->
+      let f = { first=parts; current=parts} in
+      Hashtbl.add files file f;
+      f
 
 let write_parts ~force_output file parts =
   let output_file = file ^ ".corrected" in
@@ -258,6 +260,8 @@ let update_file_or_block ?root ppf md_file ml_file block direction =
   | `To_ml ->
      update_file_with_block ppf block ml_file (Block.part block)
 
+exception Test_block_failure of Block.t * string
+
 let run_exn (`Setup ()) (`Non_deterministic non_deterministic)
     (`Not_verbose not_verbose) (`Syntax syntax) (`Silent silent)
     (`Verbose_findlib verbose_findlib) (`Prelude prelude)
@@ -296,6 +300,60 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic)
     | _ -> Fmt.failwith "only one of --prelude or --prelude-str shoud be used"
   in
 
+  let test_block ~ppf ~temp_file t =
+    let active =
+      active t && Block.version_enabled t && (not (Block.skip t))
+    in
+    match active, non_deterministic, Block.mode t, Block.value t with
+    (* Print errors *)
+    | _, _, _, Error _ -> Block.pp ?syntax ppf t
+    (* Skip raw blocks. *)
+    | true, _, _, Raw -> Block.pp ?syntax ppf t
+    (* The command is not active, skip it. *)
+    | false, _, _, _ -> Block.pp ?syntax ppf t
+    (* the command is active but non-deterministic so skip everything *)
+    | true, false, `Non_det `Command, _ -> Block.pp ?syntax ppf t
+    (* the command is active but it's output is
+       non-deterministic; run it but keep the old output. *)
+    | true, false, `Non_det `Output, Cram { tests; _ } ->
+      Block.pp ?syntax ppf t;
+      let blacklist = Block.unset_variables t in
+      List.iter (fun t ->
+          let _: int = run_test ?root blacklist temp_file t in ()
+        ) tests
+    | true, false, `Non_det `Output, Toplevel tests ->
+      assert (syntax <> Some Cram);
+      Block.pp ppf t;
+      List.iter (fun test ->
+          match eval_test t ?root c test with
+          | Ok _    -> ()
+          | Error e ->
+            let output = List.map (fun l -> `Output l) e in
+            if Output.equal test.output output then ()
+            else err_eval ~cmd:test.command e
+        ) tests
+    (* Run raw OCaml code *)
+    | true, _, _, OCaml ->
+      assert (syntax <> Some Cram);
+      (match Block.file t with
+       | Some ml_file ->
+         update_file_or_block ?root ppf file ml_file t direction
+       | None ->
+         eval_raw t ?root c ~line:t.line t.contents;
+         Block.pp ppf t )
+    (* Cram tests. *)
+    | true, _, _, Cram { tests; pad } ->
+      run_cram_tests ?syntax t ?root ppf temp_file pad tests
+    (* Top-level tests. *)
+    | true, _, _, Toplevel tests ->
+      assert (syntax <> Some Cram);
+      match Block.file t with
+      | Some ml_file ->
+        update_file_or_block ?root ppf file ml_file t direction
+      | 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);
@@ -306,73 +364,41 @@ let run_exn (`Setup ()) (`Non_deterministic non_deterministic)
           | 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 () ->
-                 let active =
-                   active t && Block.version_enabled t && (not (Block.skip t))
-                 in
-                 match active, non_deterministic, Block.mode t, Block.value t with
-                 (* Print errors *)
-                 | _, _, _, Error _ -> Block.pp ?syntax ppf t
-                 (* Skip raw blocks. *)
-                 | true, _, _, Raw -> Block.pp ?syntax ppf t
-                 (* The command is not active, skip it. *)
-                 | false, _, _, _ -> Block.pp ?syntax ppf t
-                 (* the command is active but non-deterministic so skip everything *)
-                 | true, false, `Non_det `Command, _ -> Block.pp ?syntax ppf t
-                 (* the command is active but it's output is
-                    non-deterministic; run it but keep the old output. *)
-                 | true, false, `Non_det `Output, Cram { tests; _ } ->
-                   Block.pp ?syntax ppf t;
-                   let blacklist = Block.unset_variables t in
-                   List.iter (fun t ->
-                       let _: int = run_test ?root blacklist temp_file t in ()
-                     ) tests
-                 | true, false, `Non_det `Output, Toplevel tests ->
-                   assert (syntax <> Some Cram);
-                   Block.pp ppf t;
-                   List.iter (fun test ->
-                       match eval_test t ?root c test with
-                       | Ok _    -> ()
-                       | Error e ->
-                         let output = List.map output_from_line e in
-                         if Output.equal test.output output then ()
-                         else err_eval ~cmd:test.command e
-                     ) tests
-                 (* Run raw OCaml code *)
-                 | true, _, _, OCaml ->
-                   assert (syntax <> Some Cram);
-                   (match Block.file t with
-                    | Some ml_file ->
-                      update_file_or_block ?root ppf file ml_file t direction
-                    | None ->
-                      eval_raw t ?root c ~line:t.line t.contents;
-                      Block.pp ppf t )
-                 (* Cram tests. *)
-                 | true, _, _, Cram { tests; pad } ->
-                   run_cram_tests ?syntax t ?root ppf temp_file pad tests
-                 (* Top-level tests. *)
-                 | true, _, _, Toplevel tests ->
-                   assert (syntax <> Some Cram);
-                   match Block.file t with
-                   | Some ml_file ->
-                     update_file_or_block ?root ppf file ml_file t direction
-                   | None ->
-                     run_toplevel_tests ?root c ppf tests 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);
   Hashtbl.iter (write_parts ~force_output) files;
   0
 
+let report_error_in_block block msg =
+  let kind =
+    match block.Block.value with
+    | Raw | Error _ -> ""
+    | OCaml -> "OCaml "
+    | Cram _ -> "cram "
+    | Toplevel _ -> "toplevel "
+  in
+  Fmt.epr "Error in the %scode block in %s at line %d:@]\n%s\n"
+    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 =
     try
     run_exn setup non_deterministic not_verbose syntax silent verbose_findlib
       prelude prelude_str file section root direction force_output
-    with Failure f -> (prerr_endline f; exit 1)
-
+    with
+    | Failure f ->
+      prerr_endline f;
+      1
+    | Test_block_failure (block, msg) ->
+      report_error_in_block block msg;
+      1
+
 (**** Cmdliner ****)
 
 open Cmdliner

test/dune

@@ -152,3 +152,21 @@
  (name   runtest)
  (deps   (:x section.out) (:y section.out.expected))
  (action (diff? %{x} %{y})))
+
+; Test failures
+
+(rule
+ (targets failures.outputs)
+ (deps    (package mdx) failures/empty.ml)
+ (action
+  (with-outputs-to %{targets}
+   (progn
+    (system "%{bin:ocaml-mdx} test --prelude=a --prelude-str=b %{dep:failures/empty.md} || echo")
+    (system "%{bin:ocaml-mdx} test --direction=to-md %{dep:failures/part_not_found.md} || echo")
+    (system "%{bin:ocaml-mdx} test --direction=to-md %{dep:failures/ml_file_not_found.md} || echo")
+    (system "%{bin:ocaml-mdx} test --direction=to-md %{dep:failures/in_toplevel.md} || echo")
+   ))))
+
+(alias
+ (name runtest)
+ (action (diff failures.expected failures.outputs)))

test/failures.expected

@@ -0,0 +1,11 @@
+only one of --prelude or --prelude-str shoud be used
+
+Error in the OCaml code block in failures/part_not_found.md at line 4:
+Cannot find part "part1" in failures/empty.ml
+
+Error in the OCaml code block in failures/ml_file_not_found.md at line 4:
+failures/not_found.ml: No such file or directory
+
+Error in the toplevel code block in failures/in_toplevel.md at line 4:
+failures/not_found.ml: No such file or directory
+

test/failures/in_toplevel.md

@@ -0,0 +1,5 @@
+Testing error message
+
+```ocaml file=not_found.ml
+# 1 + 1;
+```

test/failures/ml_file_not_found.md

@@ -0,0 +1,4 @@
+Run this with `--direction=to-md`
+
+```ocaml file=not_found.ml
+```

test/failures/part_not_found.md

@@ -0,0 +1,4 @@
+Run this with `--direction=to-md`
+
+```ocaml file=empty.ml,part=part1
+```