Commit ea416eb4 authored by Kim Nguyễn's avatar Kim Nguyễn
Browse files

Move common test functions in a separate lib.

parent c5110182
# 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
; 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)))
......
; 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)))
......
(executable
(name gen_dune)
(libraries libtest)
)
\ No newline at end of file
(* 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
(library
(name libtest)
(wrapped false)
(libraries )
)
\ No newline at end of file
(* 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"
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment