Merge pull request #178 from CraigFe/refactor-tests

Clean up end-to-end testing

dune-project

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

test/bin/dune

@@ -0,0 +1,4 @@
+(executable
+ (name gen_dune_rules)
+ (libraries cmdliner fmt unix)
+ (modules gen_dune_rules))

test/bin/gen_dune_rules.ml

@@ -0,0 +1,152 @@
+(*
+ * 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;
+    assert false
+  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 'ocaml-mdx test [options] <file>' produces a '<file>.corrected'
+    file which is equal to '<file>.expected'. *)
+let test_expect_rule file =
+  let expected_file = 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
+
+(** Tests that 'ocaml-mdx test [options] <file>' exits with a failing code and
+    that its output is equal to '<file>.expected'. *)
+let test_failure_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}"))))
+
+(alias
+  (name runtest)
+  (action
+    (diff %s %s)))
+|}
+    target_file
+    pp_options options file
+    expected_file target_file
+
+let rule_gen rule_type () =
+  let rule_generator = match rule_type with
+    | `Test_fixpoint -> test_fixpoint_rule
+    | `Test_expect -> test_expect_rule
+    | `Test_failure -> test_failure_rule
+  in
+  Sys.readdir "."
+  |> Array.to_list
+  |> List.sort String.compare
+  |> List.filter is_testcase
+  |> List.iter rule_generator
+
+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_failure) $ const (), info "test_failure";
+  ]
+
+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,10 @@
+(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,26 @@
+(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,17 @@
+(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})))

test/bin/pp_expect/skip.md

@@ -0,0 +1,14 @@
+## Skipped blocks
+
+```ocaml
+let () = assert true
+```
+
+This block should not be executed by the tests:
+```ocaml skip
+let () = assert false (* Don't print this! *)
+```
+
+```ocaml
+let () = assert true
+```

test/bin/pp_expect/skip.ml.expected

@@ -0,0 +1,6 @@
+#4 "skip.md"
+let () = assert true
+;;
+#13 "skip.md"
+let () = assert true
+;;

test/bin/test_expect/dir1.md.expected

@@ -0,0 +1,7 @@
+It's possible to run cram tests in separate directories:
+
+
+```sh dir=test
+$ basename $(dirname $(pwd))
+bin
+```

test/bin/test_expect/dir1.opts

@@ -0,0 +1 @@
+--root "../../../bin"

test/bin/test_expect/dir2.opts

@@ -0,0 +1 @@
+--root "../../.."

test/bin/test_expect/dune

@@ -0,0 +1,20 @@
+(include dune.inc)
+
+(rule
+ (targets dune.gen)
+ (deps
+  (source_tree .))
+ (action
+  (with-stdout-to
+   %{targets}
+   (run ../gen_dune_rules.exe test_expect))))
+
+(alias
+ (name runtest)
+ (action
+  (diff dune.inc dune.gen)))
+
+; Ensure that dir.md and dir2.md are identical
+
+(rule
+ (copy dir.md dir2.md))

test/bin/test_expect/dune.inc

@@ -0,0 +1,70 @@
+
+(alias
+  (name runtest)
+  (deps (:x dir1.md) (:y dir1.md.expected) (package mdx))
+  (action
+    (progn
+      (run ocaml-mdx test --force-output --root "../../../bin" %{x})
+      (diff? %{y} %{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 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 labels.md) (:y labels.md.expected) (package mdx))
+  (action
+    (progn
+      (run ocaml-mdx test --force-output  %{x})
+      (diff? %{y} %{x}.corrected))
+  )
+)
+
+(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 sync_to_md.md) (:y sync_to_md.md.expected) (package mdx))
+  (action
+    (progn
+      (run ocaml-mdx test --force-output --direction=to-md %{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))
+  )
+)

test/labels.md → test/bin/test_expect/labels.md

@@ -6,4 +6,4 @@ $ ls
 
 ```sh toto,dir=xxx
 $ xxx
-```
+```

test/bin/test_expect/labels.opt

@@ -0,0 +1 @@
+-s Testing