Move common test functions in a separate lib.

tests/README.md

 # Testing
 
+## Layout
 Testing is split in several categories. Each category contains a `good/` and
 optionally a `bad` directory for expected to succeed and expected to fail tests.
 It also contains a `src` directory with the code used to generate the
@@ -27,3 +28,35 @@ directory may be present to share code and input files between `good` and `bad`.
     - `good`:
     - `bad`:
 
+## Running tests
+Tests are simply run by invoking 
+```
+dune runtest
+```
+
+
+## Changing the result of a test
+Expected results of tests are in `.exp` files. When the result of an *existing*
+test changes (and thus the diff with the `.exp` file fails), one needs to
+promote the new result as the reference one, using
+```
+dune promote
+```
+right after the failing ```dune runtest```.
+
+## Adding test
+To add a new test, one needs to add the file in the relevent directory (together
+with its data or code dependencies) and run 
+```
+dune build @depend --auto-promote
+```
+This will list all the tests in each test directory and will output for each one a set of testing
+rules in the correct `dune` file.
+
+## Adding a test category
+A category consists of several elements:
+ * a directory structure (/e.g./ `good/`, `bad/`, …)
+ * a `dune` file in each directory containing tests to be run
+ * a `dune.auto` file, containing the list of all testing rules for the directory
+ * a `src/gen_dune.ml` file which is a program used by the `dune` file to generate the `dune.auto`
+   file. This program can use the private `lib_test` library.
\ No newline at end of file

tests/full/bad/dune.auto

 ; begin: integer_bad_div.cd
 (rule (deps integer_bad_div.cd) (target integer_bad_div.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps integer_bad_div.cdo) (target integer_bad_div.out)
    (action (with-outputs-to %{target} (with-accepted-exit-codes (not 0) (run cduce --run  %{deps})))))
 (rule (alias integer_bad_div) (action (diff integer_bad_div.exp integer_bad_div.out)))
@@ -8,7 +8,7 @@
 
 ; begin: integer_bad_mod.cd
 (rule (deps integer_bad_mod.cd) (target integer_bad_mod.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps integer_bad_mod.cdo) (target integer_bad_mod.out)
    (action (with-outputs-to %{target} (with-accepted-exit-codes (not 0) (run cduce --run  %{deps})))))
 (rule (alias integer_bad_mod) (action (diff integer_bad_mod.exp integer_bad_mod.out)))
@@ -16,7 +16,7 @@
 
 ; begin: no_ocamliface.cd
 (rule (deps no_ocamliface.cd) (target no_ocamliface.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps no_ocamliface.cdo) (target no_ocamliface.out)
    (action (with-outputs-to %{target} (with-accepted-exit-codes (not 0) (run cduce --run %{read-lines:no_ocamliface.rflags} %{deps})))))
 (rule (alias no_ocamliface) (action (diff no_ocamliface.exp no_ocamliface.out)))
@@ -24,7 +24,7 @@
 
 ; begin: no_url_loader.cd
 (rule (deps no_url_loader.cd) (target no_url_loader.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps no_url_loader.cdo) (target no_url_loader.out)
    (action (with-outputs-to %{target} (with-accepted-exit-codes (not 0) (run cduce --run %{read-lines:no_url_loader.rflags} %{deps})))))
 (rule (alias no_url_loader) (action (diff no_url_loader.exp no_url_loader.out)))
@@ -32,7 +32,7 @@
 
 ; begin: no_xml_plugin.cd
 (rule (deps no_xml_plugin.cd) (target no_xml_plugin.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps no_xml_plugin.cdo) (target no_xml_plugin.out)
    (action (with-outputs-to %{target} (with-accepted-exit-codes (not 0) (run cduce --run %{read-lines:no_xml_plugin.rflags} %{deps})))))
 (rule (alias no_xml_plugin) (action (diff no_xml_plugin.exp no_xml_plugin.out)))
@@ -40,7 +40,7 @@
 
 ; begin: stack_overflow.cd
 (rule (deps stack_overflow.cd) (target stack_overflow.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps stack_overflow.cdo) (target stack_overflow.out)
    (action (with-outputs-to %{target} (with-accepted-exit-codes (not 0) (run cduce --run  %{deps})))))
 (rule (alias stack_overflow) (action (diff stack_overflow.exp stack_overflow.out)))

tests/full/good/dune.auto

 ; begin: addrbook.cd
 (rule (deps addrbook.cd) (target addrbook.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps addrbook.cdo) (target addrbook.out)
    (action (ignore-stderr (with-stdout-to %{target} (with-accepted-exit-codes 0 (run cduce --run  %{deps}))))))
 (rule (alias addrbook) (action (diff addrbook.exp addrbook.out)))
@@ -8,7 +8,7 @@
 
 ; begin: integers.cd
 (rule (deps integers.cd) (target integers.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps integers.cdo) (target integers.out)
    (action (ignore-stderr (with-stdout-to %{target} (with-accepted-exit-codes 0 (run cduce --run  %{deps}))))))
 (rule (alias integers) (action (diff integers.exp integers.out)))
@@ -16,7 +16,7 @@
 
 ; begin: lazy.cd
 (rule (deps lazy.cd) (target lazy.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps lazy.cdo) (target lazy.out)
    (action (ignore-stderr (with-stdout-to %{target} (with-accepted-exit-codes 0 (run cduce --run  %{deps}))))))
 (rule (alias lazy) (action (diff lazy.exp lazy.out)))
@@ -24,7 +24,7 @@
 
 ; begin: overloading.cd
 (rule (deps overloading.cd) (target overloading.cdo)
-   (action (with-accepted-exit-codes 0 (run cduce --compile  %{deps}))))
+   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile  %{deps})))))
 (rule (deps overloading.cdo) (target overloading.out)
    (action (ignore-stderr (with-stdout-to %{target} (with-accepted-exit-codes 0 (run cduce --run  %{deps}))))))
 (rule (alias overloading) (action (diff overloading.exp overloading.out)))

tests/full/src/dune

 (executable
  (name gen_dune)
+ (libraries libtest)
 )
\ No newline at end of file

tests/full/src/gen_dune.ml

-(* Inspired by F. Pottier's test infrastructure for Menhir *)
-
-type kind = Good | Bad
-
-let kind = ref Good
-
-let files = ref []
-
-let spec =
-  Arg.(
-    align
-      [
-        ( "--kind",
-          String
-            (function
-            | "good" -> kind := Good
-            | "bad"  -> kind := Bad
-            | _      -> raise @@ Bad "the kind must be `good` or `bad`."),
-          "  <good|bad> sets the kind of tests to generate (defeault: good)" );
-      ])
-
-let input_files s = files := s :: !files
-
-let usage = Format.sprintf "%s [options] <file> [...]" Sys.argv.(0)
-
-let check_file f ext =
-  Filename.check_suffix f ext && Sys.file_exists f
-
-let protect f g =
-  try
-    let r = f () in
-    g ();
-    r
-  with e ->
-    g ();
-    raise e
-
-let compile_rule cflags f cdo =
-  let cf = if Sys.file_exists cflags then "%%{read:" ^ cflags ^ "}" else "" in
-  Format.printf
-    "(rule (deps %s) (target %s)\n\
-    \   (action (with-accepted-exit-codes 0 (run cduce --compile %s %%{deps}))))\n"
-    f cdo cf
-
-let run_rule rflags cdo output kind =
-  let rf = if Sys.file_exists rflags then "%{read-lines:" ^ rflags ^ "}" else "" in
-  let write_output, close, code =
-    match kind with
-    | Good -> ("ignore-stderr (with-stdout-to", ")", "0")
-    | Bad  -> ("with-outputs-to", "", "(not 0)")
-  in
-  Format.printf
-    "(rule (deps %s) (target %s)\n\
-    \   (action (%s %%{target} (with-accepted-exit-codes %s (run cduce --run \
-     %s %%{deps})))%s))\n"
-    cdo output write_output code rf close
-
-let diff_rule base exp out =
-  Format.printf "(rule (alias %s) (action (diff %s %s)))\n" base exp out
-
-let gen_test kind ext acc f =
-  if check_file f ext then begin
-    let base = Filename.remove_extension f in
-    let cdo = base ^ ".cdo" in
-    let out = base ^ ".out" in
-    let exp = base ^ ".exp" in
-    let rflags = base ^ ".rflags" in
-    let cflags = base ^ ".cflags" in
-    Format.printf "; begin: %s\n" f;
-    compile_rule cflags f cdo;
-    run_rule rflags cdo out kind;
-    diff_rule base exp out;
-    Format.printf "; end: %s\n\n" f;
-
-    Format.sprintf "(alias %s)" base :: acc
-  end
-  else acc
 
 let () =
-  Arg.parse spec input_files usage;
-  let files = List.sort_uniq String.compare !files in
-  let aliases = List.fold_left (gen_test !kind ".cd") [] files in
-  Format.printf
-    "(alias (name runtest)
-   (deps
-    (source_tree ../common)\n";
-  List.iter (Format.printf "    %s\n") (List.rev aliases);
-  Format.printf "))\n"
+Libtest.parse_argv ();
+Libtest.gen_cduce_tests !Libtest.kind !Libtest.files

tests/libtest/dune

+(library
+ (name libtest)
+ (wrapped false)
+ (libraries )
+ )
\ No newline at end of file

tests/libtest/libtest.ml

+(* Inspired by F. Pottier's test infrastructure for Menhir *)
+type kind = Good | Bad
+let kind = ref Good
+
+let files = ref []
+
+let spec =
+      Arg.[
+        ( "--kind",
+          String
+            (function
+            | "good" -> kind := Good
+            | "bad"  -> kind := Bad
+            | _      -> raise @@ Bad "the kind must be `good` or `bad`."),
+          "  <good|bad> sets the kind of tests to generate (defeault: good)" );
+      ]
+
+let input_files s = files := s :: !files
+let usage = Format.sprintf "%s [options] <file> [...]" Sys.argv.(0)
+
+let parse_argv ?(extra=[]) () = 
+  let spec = Arg.align (spec @ extra) in
+  Arg.parse spec input_files usage
+
+let check_file f ext =
+  Filename.check_suffix f ext && Sys.file_exists f
+
+let protect f g =
+  try
+    let r = f () in
+    g ();
+    r
+  with e ->
+    g ();
+    raise e
+
+let cduce_compile_rule base =
+  let cflags = base ^ ".cflags" in
+  let cdo = base ^ ".cdo" in
+  let cd = base ^ ".cd" in
+  let cf = if Sys.file_exists cflags then "%%{read:" ^ cflags ^ "}" else "" in
+  Format.printf
+    "(rule (deps %s) (target %s)\n\
+    \   (action (ignore-outputs (with-accepted-exit-codes 0 (run cduce --compile %s %%{deps})))))\n"
+    cd cdo cf
+
+let cduce_run_rule base kind =
+  let rflags = base ^ ".rflags" in
+  let cdo = base ^ ".cdo" in
+  let out = base ^ ".out" in
+  let rf = if Sys.file_exists rflags then "%{read-lines:" ^ rflags ^ "}" else "" in
+  let write_output, close, code =
+    match kind with
+    | Good -> ("ignore-stderr (with-stdout-to", ")", "0")
+    | Bad  -> ("with-outputs-to", "", "(not 0)")
+  in
+  Format.printf
+    "(rule (deps %s) (target %s)\n\
+    \   (action (%s %%{target} (with-accepted-exit-codes %s (run cduce --run \
+     %s %%{deps})))%s))\n"
+    cdo out write_output code rf close
+
+let diff_rule base =
+  let exp = base ^ ".exp" in
+  let out = base ^ ".out" in
+  Format.printf "(rule (alias %s) (action (diff %s %s)))\n" base exp out
+
+let gen_cduce_test kind acc f =
+  if check_file f ".cd" then begin
+    let base = Filename.remove_extension f in
+    Format.printf "; begin: %s\n" f;
+    cduce_compile_rule base;
+    cduce_run_rule base kind;
+    diff_rule base;
+    Format.printf "; end: %s\n\n" f;
+
+    Format.sprintf "(alias %s)" base :: acc
+  end
+  else acc
+
+let gen_cduce_tests kind files =
+  let files = List.sort_uniq String.compare files in
+  let aliases = List.fold_left (gen_cduce_test kind) [] files in
+  Format.printf
+    "(alias (name runtest)
+   (deps
+    (source_tree ../common)\n";
+  List.iter (Format.printf "    %s\n") (List.rev aliases);
+  Format.printf "))\n"