Add tests for failures

dune-project

@@ -1,2 +1,2 @@
-(lang dune 1.0)
+(lang dune 1.11)
 (name mdx)

test/bin/dune

@@ -1,165 +1,5 @@
-(include dune.inc)
-
-; Generates rules
-
-(rule
- (targets dune.inc.gen)
- (deps    (package mdx))
- (action
-  (with-stdout-to %{targets}
-   (progn
-    (run ocaml-mdx rule %{dep:pp.md})
-    (run ocaml-mdx rule %{dep:ellipsis.md})
-    (run ocaml-mdx rule %{dep:envs.md})
-    (run ocaml-mdx rule %{dep:empty_line.md})
-    (run ocaml-mdx rule %{dep:spaces.md})
-    (run ocaml-mdx rule %{dep:errors.md})
-    (run ocaml-mdx rule %{dep:heredoc.md})
-    (run ocaml-mdx rule %{dep:mlt.md})
-    (run ocaml-mdx rule %{dep:semisemi.md})
-    (run ocaml-mdx rule %{dep:exit.md})
-    (run ocaml-mdx rule %{dep:padding.md})
-    (run ocaml-mdx rule %{dep:multilines.md})
-    (run ocaml-mdx rule %{dep:lines.md})
-    (run ocaml-mdx rule %{dep:lwt.md})
-    (run ocaml-mdx rule %{dep:non-det.md})
-    (run ocaml-mdx rule %{dep:code.md})
-    (run ocaml-mdx rule %{dep:set_environment_variable.md})
-    (run ocaml-mdx rule %{dep:unset_environment_variable.md})
-    (run ocaml-mdx rule --prelude-str "#require \"lwt\"" --prelude-str "toto:let x = \"42\"" %{dep:prelude.md})
-    (run ocaml-mdx rule --prelude prelude.ml %{dep:prelude_file.md})
-    (run ocaml-mdx rule --direction=to-ml %{dep:dune_rules.md})
-    (run ocaml-mdx rule %{dep:require/require-package.md})
-   ))))
-
-(alias
- (name runtest)
- (action (diff dune.inc dune.inc.gen)))
-
-(alias
- (name   runtest)
- (deps   (:x section.md) (:y section.md.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output -s Testing %{x})
-           (diff? %{y} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x labels.md) (:y labels.md.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output -s Testing %{x})
-           (diff? %{y} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x pp.md) section.md (package mdx))
- (action (progn
-           (run ocaml-mdx test %{x})
-           (diff? %{x} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x ellipsis-updates.md) (:y ellipsis-updates.md.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output %{x})
-           (diff? %{y} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x trailing.md) (:y trailing.md.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output %{x})
-           (diff? %{y} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x empty_lines.md) (:y empty_lines.md.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output %{x})
-           (diff? %{y} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x output.md) (:y output.html.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx output %{x} -o output.html)
-           (diff? %{y} output.html))))
-
-(alias
- (name   runtest)
- (deps   (:x cram.t) (package mdx))
- (action (progn
-           (run ocaml-mdx test --syntax=cram %{x})
-           (diff? %{x} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x dir.md) (package mdx))
- (action (progn
-           (run ocaml-mdx test --root "../../bin" %{x})
-           (diff? %{x} %{x}.corrected))))
-
-(rule (copy dir.md dir2.md))
-
-(alias
- (name   runtest)
- (deps   (:x dir2.md) (:y dir.md.expected) (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output --root "../.." %{x})
-           (diff? %{y} %{x}.corrected))))
-(alias
- (name   runtest)
- (deps   (:x sync_to_md.md)
-         (:y sync_to_md.md.expected)
-         sync_to_md.ml
-         (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output --direction=to-md %{x})
-           (diff? %{y} %{x}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x sync_to_ml.md) (:y sync_to_ml.md.expected)
-         (:a sync_to_ml.ml) (:b sync_to_ml.ml.expected)
-         (:c sync_to_broken_ml.ml) (:d sync_to_ml.mli)
-         (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output --direction=to-ml %{x})
-           (diff? %{y} %{x}.corrected)
-           (diff? %{b} %{a}.corrected)
-           (diff? %{c} %{c}.corrected)
-           (diff? %{d} %{d}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x sync_to_empty_ml.md)
-         (:a sync_to_empty_ml.ml) (:b sync_to_empty_ml.ml.expected)
-         (package mdx))
- (action (progn
-           (run ocaml-mdx test --force-output --direction=to-ml %{x})
-           (diff? %{b} %{a}.corrected))))
-
-(alias
- (name   runtest)
- (deps   (:x sync_to_ml_with_correct_md.md)
-         (:a sync_to_ml_with_correct_md.ml) (:b sync_to_ml_with_correct_md.ml.expected)
-         (package mdx))
- (action (progn
-           (run ocaml-mdx test --direction=to-ml %{x})
-           (diff? %{b} %{a}.corrected))))
-
-(rule
- (targets section.ml)
- (deps    (:x section.md) (package mdx))
- (action  (with-stdout-to %{targets} (run ocaml-mdx pp %{x}))))
-
 (executable
-  (name section)
-  (modules section))
-
-(rule (with-stdout-to section.out (run ./section.exe)))
-
-(alias
- (name   runtest)
- (deps   (:x section.out) (:y section.out.expected))
- (action (diff? %{x} %{y})))
+ (name gen_dune_rules)
+ (libraries cmdliner fmt unix)
+ (modules gen_dune_rules)
+)

test/bin/gen_dune_rules.ml

@@ -0,0 +1,149 @@
+(*
+ * Copyright (c) 2019 Craig Ferguson <me@craigfe.io>
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose with or without fee is hereby granted, provided that the above
+ * copyright notice and this permission notice appear in all copies.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
+ * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
+ * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
+ * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
+ * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
+ * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
+ * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+ *)
+
+let is_testcase filename =
+  let valid_extensions = [".md"; ".t"] in
+  List.exists (Filename.check_suffix filename) valid_extensions
+
+let read_file filename =
+  let lines = ref [] in
+  let chan = open_in filename in
+  try
+    while true do
+      lines := input_line chan :: !lines
+    done;
+    !lines
+  with End_of_file ->
+    close_in chan;
+    List.rev !lines
+
+let expected_file file =
+  let e = file ^ ".expected" in
+  if not (Sys.file_exists e) then
+    Fmt.failwith "No %s file found when generating an expect rule" e;
+  e
+
+(* Copied from Filename (stdlib) for pre-4.04 compatibility *)
+let chop_extension name =
+  let is_dir_sep s i = match Sys.os_type with
+    | "Unix" -> s.[i] = '/'
+    | "Win32" | "Cygwin" ->
+      let c = s.[i] in
+      c = '/' || c = '\\' || c = ':'
+    | _ -> assert false
+  in
+  let rec search_dot i =
+    if i < 0 || is_dir_sep name i then invalid_arg "Filename.chop_extension"
+    else if name.[i] = '.' then String.sub name 0 i
+    else search_dot (i - 1) in
+  search_dot (String.length name - 1)
+
+let options_of_file file =
+  let options_file = chop_extension file ^ ".opts" in
+  if not (Sys.file_exists options_file) then
+    [""]
+  else
+    read_file options_file
+
+let pp_options =
+  Fmt.(list ~sep:(const string " ") string)
+
+(* Tests that the output of 'ocaml-mdx test [options] <file>' is equal to the
+   contents of '<file>'. Uses the rule generator build into ocaml-mdx. *)
+let test_fixpoint_rule file =
+  let options = options_of_file file in
+  let command =
+    let args = file::options in
+    Fmt.strf "ocaml-mdx rule %a" pp_options args
+  in
+  match Unix.system command with
+  | WEXITED 0 -> ()
+  | WEXITED i -> exit i
+  | WSIGNALED _ | WSTOPPED _ -> exit 1
+
+(* Tests that the output of 'ocaml-mdx test [options] <file>' is equal to the
+   contents of '<file>.expected'. *)
+let test_expect_rule file =
+  let _ = expected_file file in
+  let options = options_of_file file in
+  Fmt.pr
+    {|
+(alias
+  (name runtest)
+  (deps (:x %s) (:y %s) (package mdx))
+  (action
+    (progn
+      (run ocaml-mdx test --force-output %a %%{x})
+      (diff? %%{y} %%{x}.corrected))
+  )
+)
+|}
+    file
+    expected_file
+    pp_options options
+
+let test_failures_rule file =
+  let expected_file = expected_file file in
+  let options = options_of_file file in
+  let target_file = file ^ ".actual" in
+  Fmt.pr
+    {|
+(rule
+  (targets %s)
+  (action
+    (with-outputs-to %%{targets}
+      (system "%%{bin:ocaml-mdx} test %a %%{dep:%s} || echo"))))
+
+(alias
+  (name runtest)
+  (action
+    (diff %s %s)))
+|}
+    target_file
+    pp_options options file
+    target_file expected_file
+
+let rule_gen rule_type () =
+  Sys.readdir "."
+  |> Array.to_list
+  |> List.sort String.compare
+  |> List.filter is_testcase
+  |> List.iter (match rule_type with
+      | `Test_fixpoint -> test_fixpoint_rule
+      | `Test_expect -> test_expect_rule
+      | `Test_failures -> test_failures_rule
+    )
+
+open Cmdliner
+
+let cmds =
+  Term.[
+    const (rule_gen `Test_fixpoint) $ const (), info "test_fixpoint";
+    const (rule_gen `Test_expect) $ const (), info "test_expect";
+    const (rule_gen `Test_failures) $ const (), info "test_failures";
+  ]
+
+let default =
+  let doc = "Generate dune files for the binary tests." in
+  let exits = Term.default_exits in
+  let man = [] in
+  Term.(
+    ret (const (`Help (`Auto, None))),
+    info "gen_dune_rules" ~doc ~exits ~man
+  )
+
+let () = Term.exit (Term.eval_choice default cmds)
+

test/bin/output_expect/dune

@@ -0,0 +1,6 @@
+(alias
+ (name   runtest)
+ (deps   (:x output.md) (:y output.html.expected) (package mdx))
+ (action (progn
+          (run ocaml-mdx output %{x} -o output.html)
+          (diff? %{y} output.html))))

test/bin/pp_exec/dune

@@ -0,0 +1,15 @@
+(rule
+ (targets section.ml)
+ (deps    (:x section.md) (package mdx))
+ (action  (with-stdout-to %{targets} (run ocaml-mdx pp %{x}))))
+
+(executable
+ (name section)
+ (modules section))
+
+(rule (with-stdout-to section.out (run ./section.exe)))
+
+(alias
+ (name   runtest)
+ (deps   (:x section.out) (:y section.out.expected))
+ (action (diff? %{y} %{x})))

test/bin/pp_exec/section.md

@@ -0,0 +1,37 @@
+## Title
+
+### Prints to std.out are shown in output
+
+```ocaml
+let x = 1 in
+Printf.printf "%d\n%!" x
+```
+
+```
+assert false (* not an ocaml block, shouldn't be run *)
+```
+
+### Split definition and use
+
+```ocaml
+let x = "2"
+```
+
+With an intervening shell block:
+
+```sh
+ $ for i in `seq 1 10`; do echo $i; done
+```
+
+
+```ocaml
+let () = print_endline x
+```
+
+## Top-level
+
+```ocaml
+   # print_endline "3";;
+   3
+```
+

test/bin/pp_exec/section.out.expected

@@ -0,0 +1,3 @@
+1
+2
+3

test/bin/pp_expect/dune

@@ -0,0 +1,9 @@
+(rule
+ (targets skip.ml)
+ (deps    (:x skip.md) (package mdx))
+ (action  (with-stdout-to %{targets} (run ocaml-mdx pp %{x}))))
+
+(alias
+ (name   runtest)
+ (deps   (:x skip.ml) (:y skip.ml.expected))
+ (action (diff? %{y} %{x})))