Commit 471805f1 authored by POTTIER Francois's avatar POTTIER Francois
Browse files

Remove the time limit on positive tests.

parent fd2e2200
This source diff could not be displayed because it is too large. You can view the blob instead.
...@@ -196,31 +196,33 @@ let extra id = ...@@ -196,31 +196,33 @@ let extra id =
(* The Menhir command, for use inside a rule, with an optional timeout. *) (* The Menhir command, for use inside a rule, with an optional timeout. *)
(* If the [timeout] parameter is [true], we assume that a [timeout] command (* If this is a positive test and if the [threshold] parameter is [Some _],
exists on the system, and we use it to limit Menhir's execution time. This then we assume that a [timeout] command exists on the system, and we use it
is normally not necessary, but can be useful when testing experimental to limit Menhir's execution time. This is normally not necessary, but can
extensions of Menhir. This should be used for positive tests only. *) be useful when testing experimental extensions of Menhir. *)
let threshold = let threshold =
60 (* in seconds *) None
(* or: [Some seconds] *)
let menhir_args base flags = let menhir_args base flags =
base @ flags @ A"%{deps}" :: [] base @ flags @ A"%{deps}" :: []
let menhir (timeout : bool) base flags = let menhir (impose_timeout : bool) base flags =
if timeout then match impose_timeout, threshold with
(* We must use a [system] action. *) | true, Some threshold ->
let command = (* We must use a [system] action. *)
sprintf let command =
"timeout %d %%{bin:menhir}%s || echo 'TIMEOUT after %d seconds.'" sprintf
threshold "timeout %d %%{bin:menhir}%s || echo 'TIMEOUT after %d seconds.'"
(show_list (menhir_args base flags)) threshold
threshold (show_list (menhir_args base flags))
in threshold
L[A"system"; A (sprintf "\"%s\"" command)] in
else L[A"system"; A (sprintf "\"%s\"" command)]
(* We can use a [run] action. *) | _, _ ->
L(A"run" :: A"menhir" :: menhir_args base flags) (* We can use a [run] action. *)
L(A"run" :: A"menhir" :: menhir_args base flags)
(* Constructing and printing a rule to run Menhir. (* Constructing and printing a rule to run Menhir.
...@@ -239,14 +241,13 @@ let menhir (timeout : bool) base flags = ...@@ -239,14 +241,13 @@ let menhir (timeout : bool) base flags =
let run positive basenames outputs flags = let run positive basenames outputs flags =
let output = hd outputs in let output = hd outputs in
let timeout = positive in
(* Run Menhir. *) (* Run Menhir. *)
print (rule print (rule
outputs outputs
(mlys basenames) (mlys basenames)
(redirect output ( (redirect output (
possibly_expecting_failure positive ( possibly_expecting_failure positive (
menhir timeout (base basenames) flags menhir positive (base basenames) flags
)))) ))))
(* -------------------------------------------------------------------------- *) (* -------------------------------------------------------------------------- *)
......
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