Commit 9951fc95 authored by POTTIER Francois's avatar POTTIER Francois
Browse files

test/static/src/test.ml: new auxiliary functions; better handling of --extra-flags.

parent 6ce54c77
......@@ -11,6 +11,9 @@
;; Use the script [test.ml] to generate the file [dune.auto.gen]
;; based on the content of the subdirectories [good] and [bad].
;; Note: if desired, one or more options of the form
;; --extra-flags <some-menhir-flag>
;; can be passed to ./test.exe.
(rule
(target dune.auto.gen)
(deps (source_tree ../bad) (source_tree ../good))
......
......@@ -1636,7 +1636,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base dolmen.0.2-parseDimacs %{deps})))))
(run menhir --base dolmen.0.2-parseDimacs --only-preprocess %{deps})))))
(rule (alias dolmen.0.2-parseDimacs)
(action
......@@ -1649,7 +1649,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base dolmen.0.2-parseDimacs
(run menhir --base dolmen.0.2-parseDimacs --explain -lg 2 -la 2 -lc 2
%{deps})))))
(rule (alias dolmen.0.2-parseDimacs)
......@@ -1661,7 +1661,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base dolmen.0.2-parseTptp %{deps})))))
(run menhir --base dolmen.0.2-parseTptp --only-preprocess %{deps})))))
(rule (alias dolmen.0.2-parseTptp)
(action
......@@ -1672,7 +1672,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base dolmen.0.2-parseTptp
(run menhir --base dolmen.0.2-parseTptp --explain -lg 2 -la 2 -lc 2
%{deps})))))
(rule (alias dolmen.0.2-parseTptp)
......@@ -1770,7 +1770,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base electrum00 %{deps})))))
(run menhir --base electrum00 --only-preprocess %{deps})))))
(rule (alias electrum00)
(action (diff ../good/electrum00.opp.exp electrum00.opp.out)))
......@@ -1781,7 +1781,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base electrum00 %{deps})))))
(run menhir --base electrum00 --explain -lg 2 -la 2 -lc 2 %{deps})))))
(rule (alias electrum00)
(action (diff ../good/electrum00.exp electrum00.out)))
......@@ -3768,7 +3768,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base multi-token-alias-0 %{deps})))))
(run menhir --base multi-token-alias-0 --only-preprocess %{deps})))))
(rule (alias multi-token-alias-0)
(action
......@@ -3780,7 +3780,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base multi-token-alias-0
(run menhir --base multi-token-alias-0 --explain -lg 2 -la 2 -lc 2
%{deps})))))
(rule (alias multi-token-alias-0)
......@@ -3807,7 +3807,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base name-clash-1 %{deps})))))
(run menhir --base name-clash-1 --only-preprocess %{deps})))))
(rule (alias name-clash-1)
(action (diff ../good/name-clash-1.opp.exp name-clash-1.opp.out)))
......@@ -3817,7 +3817,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base name-clash-1 %{deps})))))
(run menhir --base name-clash-1 --explain -lg 2 -la 2 -lc 2 %{deps})))))
(rule (alias name-clash-1)
(action (diff ../good/name-clash-1.exp name-clash-1.out)))
......@@ -4750,7 +4750,7 @@
(rule (target petit-1.opp.out) (deps ../good/petit-1.mly ../good/petit-2.mly)
(action
(with-outputs-to %{target}
(chdir ../good (run menhir --only-preprocess --base petit-1 %{deps})))))
(chdir ../good (run menhir --base petit-1 --only-preprocess %{deps})))))
(rule (alias petit-1)
(action (diff ../good/petit-1.opp.exp petit-1.opp.out)))
......@@ -4759,7 +4759,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base petit-1 %{deps})))))
(run menhir --base petit-1 --explain -lg 2 -la 2 -lc 2 %{deps})))))
(rule (alias petit-1) (action (diff ../good/petit-1.exp petit-1.out)))
......@@ -4853,7 +4853,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base private-and-public-1 %{deps})))))
(run menhir --base private-and-public-1 --only-preprocess %{deps})))))
(rule (alias private-and-public-1)
(action
......@@ -4865,7 +4865,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base private-and-public-1
(run menhir --base private-and-public-1 --explain -lg 2 -la 2 -lc 2
%{deps})))))
(rule (alias private-and-public-1)
......@@ -4989,7 +4989,7 @@
(deps ../good/public-1.mly ../good/public-2.mly)
(action
(with-outputs-to %{target}
(chdir ../good (run menhir --only-preprocess --base public-1 %{deps})))))
(chdir ../good (run menhir --base public-1 --only-preprocess %{deps})))))
(rule (alias public-1)
(action (diff ../good/public-1.opp.exp public-1.opp.out)))
......@@ -4998,7 +4998,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base public-1 %{deps})))))
(run menhir --base public-1 --explain -lg 2 -la 2 -lc 2 %{deps})))))
(rule (alias public-1) (action (diff ../good/public-1.exp public-1.out)))
......@@ -5007,7 +5007,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base public-inline-1 %{deps})))))
(run menhir --base public-inline-1 --only-preprocess %{deps})))))
(rule (alias public-inline-1)
(action (diff ../good/public-inline-1.opp.exp public-inline-1.opp.out)))
......@@ -5017,7 +5017,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base public-inline-1
(run menhir --base public-inline-1 --explain -lg 2 -la 2 -lc 2
%{deps})))))
(rule (alias public-inline-1)
......@@ -5863,7 +5863,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --only-preprocess --base webidl.1.4-parser00 %{deps})))))
(run menhir --base webidl.1.4-parser00 --only-preprocess %{deps})))))
(rule (alias webidl.1.4-parser00)
(action
......@@ -5875,7 +5875,7 @@
(action
(with-outputs-to %{target}
(chdir ../good
(run menhir --explain -lg 2 -la 2 -lc 2 --base webidl.1.4-parser00
(run menhir --base webidl.1.4-parser00 --explain -lg 2 -la 2 -lc 2
%{deps})))))
(rule (alias webidl.1.4-parser00)
......
......@@ -14,8 +14,8 @@ open Auxiliary
(* Settings. *)
let extra =
ref ""
let extra : string list ref =
ref []
let verbosity =
ref 0
......@@ -24,7 +24,7 @@ let usage =
sprintf "Usage: %s\n" argv.(0)
let spec = Arg.align [
"--extra-flags", Arg.String (fun flags -> extra := flags),
"--extra-flags", Arg.String (fun flag -> extra := flag :: !extra),
"<string> specify extra flags for Menhir";
"--verbosity", Arg.Int ((:=) verbosity),
" set the verbosity level (0-2)";
......@@ -33,8 +33,8 @@ let spec = Arg.align [
let () =
Arg.parse spec (fun _ -> ()) usage
let extra =
!extra
let extra : string list =
List.rev !extra
let verbosity =
!verbosity
......@@ -94,6 +94,12 @@ type sexp =
| L of sexp list
| Lnewline of sexp list
let atom sexp =
A sexp
let atoms =
List.map atom
let rec print_sexp ppf = function
| A s ->
Format.pp_print_string ppf s
......@@ -110,15 +116,65 @@ let print_sexp sexp =
(* -------------------------------------------------------------------------- *)
(* Constructing a standard [make]-like rule. *)
let rule (target : string) (deps : string list) (action : sexp) =
L[A"rule";
L[A"target"; A target];
L(A"deps" :: atoms deps);
L[A"action"; action]
]
let print_rule target deps action =
print_sexp (rule target deps action)
(* Constructing a phony rule, that is, a rule whose target is an alias. *)
let phony (alias : string) (action : sexp) =
L[A"rule";
L[A"alias"; A alias];
L[A"action"; action]
]
let print_phony alias action =
print_sexp (phony alias action)
(* Constructing a diff action. *)
let diff (expected : string) (actual : string) =
L[A"diff"; A expected; A actual]
(* -------------------------------------------------------------------------- *)
(* Calling conventions for Menhir. *)
(* A --base option is needed for groups of several files. *)
let base basenames =
if length basenames > 1 then
let id = id basenames in
[A"--base"; A id]
else
[]
(* The Menhir command. *)
(* This command is meant to be used inside a rule. *)
let menhir base flags =
L(A"run" :: A"menhir" :: base @ flags @ [A"%{deps}"])
(* -------------------------------------------------------------------------- *)
(* Running a negative test. *)
let process_negative_test basenames : unit =
(* Display an information message. *)
(* Compute the name of this test. *)
let id = id basenames in
(* A --base option is needed for groups of several files. *)
let base = if length basenames > 1 then [A"--base"; A id] else [] in
let base = base basenames in
(* The output is stored in this file. *)
let result = id ^ ".result" in
......@@ -126,7 +182,7 @@ let process_negative_test basenames : unit =
(* Flags. *)
let flags = id ^ ".flags" in
let flags =
let extra = if extra = "" then [] else [A extra] in
let extra = atoms extra in
if file_exists (bad_slash flags) then
A(sprintf "%%{read-lines:%s}" (bad_slash flags)) :: extra
else
......@@ -134,22 +190,19 @@ let process_negative_test basenames : unit =
in
(* Run Menhir in the directory bad/. *)
print_sexp
(L[A"rule";
L[A"target"; A result];
L(A"deps" :: List.map (fun mly -> A(bad_slash mly)) (mlys basenames));
L[A"action";
L[A"with-outputs-to"; A "%{target}";
L[A"chdir"; A bad;
L[A"with-accepted-exit-codes"; L[A"not"; A"0"];
L(A"run" :: A"menhir" :: base @ flags @ [A"%{deps}"])]]]]]);
print_rule
result
(List.map bad_slash (mlys basenames))
(L[A"with-outputs-to"; A "%{target}";
L[A"chdir"; A bad;
L[A"with-accepted-exit-codes"; L[A"not"; A"0"];
menhir base flags]]]);
(* Check that the output coincides with what was expected. *)
let expected = id ^ ".expected" in
print_sexp
(L[A"rule";
L[A"alias"; A id];
L[A"action"; L[A"diff"; A(bad_slash expected); A result]]])
print_phony
id
(diff (bad_slash expected) result)
(* -------------------------------------------------------------------------- *)
......@@ -166,16 +219,16 @@ let process_negative_test basenames : unit =
let process_positive_test basenames : unit =
(* Display an information message. *)
(* Compute the name of this test. *)
let id = id basenames in
(* A --base option is needed for groups of several files. *)
let base = if length basenames > 1 then [A"--base"; A id] else [] in
let base = base basenames in
(* Flags. *)
let flags = id ^ ".flags" in
let flags =
let extra = if extra = "" then [] else [A extra] in
let extra = atoms extra in
if file_exists (good_slash flags) then
A(sprintf "%%{read-lines:%s}" (good_slash flags)) :: extra
else
......@@ -184,45 +237,35 @@ let process_positive_test basenames : unit =
(* Run menhir --only-preprocess. *)
let oppout = id ^ ".opp.out" in
print_sexp
(L[A"rule";
L[A"target"; A oppout];
L(A"deps" :: List.map (fun mly -> A(good_slash mly)) (mlys basenames));
L[A"action";
L[A"with-outputs-to"; A"%{target}";
L[A"chdir"; A good;
L(A"run" :: A"menhir" :: A"--only-preprocess" :: base @ flags @
[A"%{deps}"])]]]]);
print_rule
oppout
(List.map good_slash (mlys basenames))
(L[A"with-outputs-to"; A"%{target}";
L[A"chdir"; A good;
menhir base (A"--only-preprocess" :: flags)]]);
(* Check that the output coincides with what was expected. *)
let oppexp = id ^ ".opp.exp" in
print_sexp
(L[A"rule";
L[A"alias"; A id];
L[A"action";
L[A"diff"; A(good_slash oppexp); A oppout]]]);
print_phony
id
(diff (good_slash oppexp) oppout);
(* Run menhir. *)
let out = id ^ ".out" in
print_sexp
(L[A"rule";
L[A"target"; A out];
L(A"deps" :: List.map (fun mly -> A(good_slash mly)) (mlys basenames));
L[A"action";
L[A"with-outputs-to"; A"%{target}";
L[A"chdir"; A good;
L(A"run" :: A"menhir" ::
A"--explain" :: A"-lg" :: A"2" :: A"-la" :: A"2" :: A"-lc" :: A"2" ::
base @ flags @
[A"%{deps}"])]]]]);
print_rule
out
(List.map good_slash (mlys basenames))
(L[A"with-outputs-to"; A"%{target}";
L[A"chdir"; A good;
menhir base (
A"--explain" :: A"-lg" :: A"2" :: A"-la" :: A"2" :: A"-lc" :: A"2" ::
flags)]]);
(* Check that the output coincides with what was expected. *)
let exp = id ^ ".exp" in
print_sexp
(L[A"rule";
L[A"alias"; A id];
L[A"action";
L[A"diff"; A(good_slash exp); A out]]])
print_phony
id
(diff (good_slash exp) out)
(* -------------------------------------------------------------------------- *)
......
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