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

Add custom flag files for cduce tests and negative tests for plugin loading.

parent ff0b5fa7
;Taken from Menhir's test directory, all credits to F. Pottier and Y. Regis-Gianas
(rule
(target dune.auto.gen)
(deps (glob_files *.cd))
(deps (source_tree .))
(action (with-stdout-to %{target} (run ../src/gen_dune.exe --kind bad %{deps})))
)
......
; 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 (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})))))
(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)))
; end: integer_bad_div.cd
; 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 (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})))))
(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)))
; end: integer_bad_mod.cd
; begin: no_ocamliface.cd
(rule (deps no_ocamliface.cd) (target no_ocamliface.cdo)
(action (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)))
; end: no_ocamliface.cd
; 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}))))
(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)))
; end: no_url_loader.cd
; 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}))))
(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)))
; end: no_xml_plugin.cd
; begin: stack_overflow.cd
(rule (deps stack_overflow.cd) (target stack_overflow.cdo)
(action (with-accepted-exit-codes 0 (run cduce --compile %{deps}))))
(action (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})))))
(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)))
; end: stack_overflow.cd
(alias (name runtest)
(deps
(source_tree ../common)
(alias integer_bad_div)
(alias integer_bad_mod)
(alias stack_overflow)
(source_tree ../common)
(alias integer_bad_div)
(alias integer_bad_mod)
(alias no_ocamliface)
(alias no_url_loader)
(alias no_xml_plugin)
(alias stack_overflow)
))
Fatal error: no support for the OCaml interface.
--no
ocaml
--mlstub
\ No newline at end of file
let _ = load_file "https://www.cduce.org"
Error "https://www.cduce.org":
cduce compiled without support for external URL loading
--no
curl
--no
netclient
\ No newline at end of file
let _ = load_xml "string:<a></a>";;
\ No newline at end of file
Fatal error: exception Failure("No XML parser available")
--no
pxp
--no
expat
--no
markup
\ No newline at end of file
;Taken from Menhir's test directory, all credits to F. Pottier and Y. Regis-Gianas
(rule
(target dune.auto.gen)
(deps (glob_files *.cd))
(deps (source_tree .))
(action (with-stdout-to %{target} (run ../src/gen_dune.exe --kind good %{deps})))
)
......
; begin: addrbook.cd
(rule (deps addrbook.cd) (target addrbook.cdo)
(action (with-accepted-exit-codes 0 (run cduce --compile %{deps}))))
(action (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}))))))
(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)))
; end: addrbook.cd
; begin: integers.cd
(rule (deps integers.cd) (target integers.cdo)
(action (with-accepted-exit-codes 0 (run cduce --compile %{deps}))))
(action (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}))))))
(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)))
; end: integers.cd
; begin: lazy.cd
(rule (deps lazy.cd) (target lazy.cdo)
(action (with-accepted-exit-codes 0 (run cduce --compile %{deps}))))
(action (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}))))))
(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)))
; end: lazy.cd
; begin: overloading.cd
(rule (deps overloading.cd) (target overloading.cdo)
(action (with-accepted-exit-codes 0 (run cduce --compile %{deps}))))
(action (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}))))))
(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)))
; end: overloading.cd
(alias (name runtest)
(deps
(source_tree ../common)
(alias addrbook)
(alias integers)
(alias lazy)
(alias overloading)
(source_tree ../common)
(alias addrbook)
(alias integers)
(alias lazy)
(alias overloading)
))
(* 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 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 usage = Format.sprintf "%s [options] <file> [...]" Sys.argv.(0)
let check_file f ext =
if not (Filename.check_suffix f ext) then begin
Format.eprintf "Warning: ignoring file %s with bad extension (expecting %s)" f ext;
false
end else if not (Sys.file_exists f) then begin
Format.eprintf "Warning: ignoring non-existent file %s" f;
false
end else true
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
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 compile_rule f cdo =
Format.printf
"(rule (deps %s) (target %s)
(action (with-accepted-exit-codes 0 (run cduce --compile %%{deps}))))\n"
f cdo
let run_rule cdo output kind =
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)"
match kind with
| Good -> ("ignore-stderr (with-stdout-to", ")", "0")
| Bad -> ("with-outputs-to", "", "(not 0)")
in
Format.printf
"(rule (deps %s) (target %s)
(action (%s %%{target} (with-accepted-exit-codes %s (run cduce --run %%{deps})))%s))\n"
cdo output write_output code close
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
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
......@@ -57,22 +64,25 @@ let gen_test kind ext acc f =
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 f cdo;
run_rule cdo out kind;
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
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\n
(source_tree ../common)\n";
List.iter (Format.printf " %s\n") (List.rev aliases);
Format.printf "))\n"
\ No newline at end of file
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"
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