Commit 14acd03b authored by POTTIER Francois's avatar POTTIER Francois

The OCaml version of the negative tests is running.

parent 03a93da5
......@@ -7,6 +7,7 @@ all:
$(OCAMLBUILD) $(TARGET)
test: all
$(MAKE) -C ../../src bootstrap
./$(TARGET)
clean:
......
true: \
warn(A-44), \
package(str), \
package(unix), \
package(functory)
......@@ -117,7 +117,7 @@ let rec groups1 eq groups x group ys =
if eq x y then
groups1 eq groups x (y :: group) ys
else
groups0 eq (group :: groups) (y :: ys)
groups0 eq (List.rev group :: groups) (y :: ys)
and groups0 eq groups ys =
match ys with
......@@ -141,6 +141,13 @@ let chop_numeric_suffix s =
let equal_up_to_numeric_suffix s1 s2 =
chop_numeric_suffix s1 = chop_numeric_suffix s2
let dash_numeric_suffix =
Str.regexp "-[0-9]*$"
let chop_dash_numeric_suffix s =
let offset = Str.search_forward dash_numeric_suffix s 0 in
String.sub s 0 offset
(* [sep ss] separates the strings in the list [ss] with a space,
and concatenates everything, producing a single string. *)
......
......@@ -7,6 +7,23 @@ open Auxiliary
(* -------------------------------------------------------------------------- *)
(* Settings. *)
(* 0 is minimal verbosity;
1 shows some progress messages;
2 is maximal verbosity. *)
let verbosity =
1
let log level format =
kprintf (fun s ->
if level <= verbosity then
print_string s
) format
(* -------------------------------------------------------------------------- *)
(* Paths. *)
let root =
......@@ -19,21 +36,21 @@ let src =
let bad =
root ^ "/bench/bad"
(* We use the stage 2 executable (i.e., Menhir compiled by Menhir)
because it has better syntax error messages and we want to test
them. *)
(* The standard library is the one in [src], viewed from [test/bad]
or [test/good], so we use the relative path [../../src]. *)
let menhir =
src ^ "/_stage1/menhir.native --stdlib " ^ src
src ^ "/_stage2/menhir.native --stdlib ../../src"
(* -------------------------------------------------------------------------- *)
(* Test files and groups of test files. *)
let id basenames =
(* A name for a group of test files. *)
if length basenames = 1 then
hd basenames
else
sprintf "%s[0-9] (%d files)"
(chop_numeric_suffix (hd basenames))
(length basenames)
(* A name for a nonempty group of test files. *)
hd basenames
let thisfile basenames =
if length basenames > 1 then "these input files" else "this input file"
......@@ -55,11 +72,17 @@ type input =
let print_input = function
| NegativeTest basenames ->
hd basenames
id basenames
type outcome =
| Success
| Failure of string (* message *)
| OK
| Fail of string (* message *)
let print_outcome = function
| OK ->
""
| Fail msg ->
msg
type output =
input * outcome
......@@ -67,36 +90,57 @@ type output =
type inputs = input list
type outputs = output list
let process input : output =
match input with
let prepare (bits : string list) : command =
let cmd = sep bits in
log 2 "%s\n%!" cmd;
cmd
let process_negative_test basenames : unit =
(* Informational message. *)
let id = id basenames in
log 1 "Testing %s...\n%!" id;
(* A --base option is needed for groups of several files. *)
let base = if length basenames > 1 then sprintf "--base %s" id else "" in
(* The output is stored in this file. *)
let result = id ^ ".result" in
(* Run Menhir in the directory bad/. *)
let cmd = prepare (
"cd" :: bad :: "&&" ::
menhir :: base :: mlys basenames @ sprintf ">%s" result :: "2>&1" :: []
) in
if command cmd = 0 then begin
log 1 "[FAIL] %s\n%!" id;
fail "menhir should not accept %s.\n" (thisfile basenames)
end;
(* Check that the output coincides with what was expected. *)
let expected = id ^ ".expected" in
let cmd = prepare (
"cd" :: bad :: "&&" ::
"diff" :: expected :: result :: []
) in
if succeeds cmd then
log 1 "[OK] %s\n%!" id
else begin
log 1 "[FAIL] %s\n%!" id;
fail "menhir correctly rejects %s, with incorrect output.\n(%s)\n"
(thisfile basenames)
cmd
end
(* A negative test. *)
| NegativeTest basenames ->
(* Informational message. *)
let id = id basenames in
printf "Testing %s...\n%!" id;
(* A --base option is needed for groups of several files. *)
let base =
if length basenames > 1 then
sprintf "--base %s" (chop_numeric_suffix (hd basenames))
else
""
in
(* Run Menhir. *)
let command = sep (menhir :: base :: mlys basenames) in
if succeeds command then begin
printf "[FAIL] %s\n%!" id;
let msg = sprintf "menhir should not accept %s." (thisfile basenames) in
input, Failure msg
end
else begin
printf "[OK] %s\n%!" id;
input, Success
end
let process input : output =
try
begin match input with
| NegativeTest basenames ->
process_negative_test basenames
end;
input, OK
with Failure msg ->
input, Fail msg
(* -------------------------------------------------------------------------- *)
......@@ -106,7 +150,7 @@ let run (inputs : inputs) : outputs =
Functory.Cores.set_number_of_cores (get_number_of_cores ());
(* Functory.Control.set_debug true; *)
flush stdout; flush stderr;
let outputs = Functory.Cores.map process inputs in
let outputs = Functory.Cores.map ~f:process inputs in
outputs
(* -------------------------------------------------------------------------- *)
......@@ -134,11 +178,11 @@ let outputs : outputs =
run negative
let successful, failed =
partition (fun (_, o) -> o = Success) outputs
partition (fun (_, o) -> o = OK) outputs
let () =
printf "%d out of %d tests are successful.\n"
(length successful) (length inputs);
failed |> iter (fun (input, outcome) ->
printf "[FAIL] %s\n" (print_input input)
printf "\n[FAIL] %s\n%s" (print_input input) (print_outcome outcome)
)
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