Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
M
menhir
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Issues
12
Issues
12
List
Boards
Labels
Service Desk
Milestones
Merge Requests
0
Merge Requests
0
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Container Registry
Analytics
Analytics
CI / CD
Repository
Value Stream
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
POTTIER Francois
menhir
Commits
14acd03b
Commit
14acd03b
authored
Mar 30, 2017
by
POTTIER Francois
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
The OCaml version of the negative tests is running.
parent
03a93da5
Changes
4
Hide whitespace changes
Inline
Side-by-side
Showing
4 changed files
with
97 additions
and
44 deletions
+97
-44
bench/src/Makefile
bench/src/Makefile
+1
-0
bench/src/_tags
bench/src/_tags
+1
-0
bench/src/auxiliary.ml
bench/src/auxiliary.ml
+8
-1
bench/src/test.ml
bench/src/test.ml
+87
-43
No files found.
bench/src/Makefile
View file @
14acd03b
...
...
@@ -7,6 +7,7 @@ all:
$(OCAMLBUILD)
$(TARGET)
test
:
all
$(MAKE)
-C
../../src bootstrap
./
$(TARGET)
clean
:
...
...
bench/src/_tags
View file @
14acd03b
true: \
warn(A-44), \
package(str), \
package(unix), \
package(functory)
bench/src/auxiliary.ml
View file @
14acd03b
...
...
@@ -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. *)
...
...
bench/src/test.ml
View file @
14acd03b
...
...
@@ -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
^
"/_stage
1/menhir.native --stdlib "
^
src
src
^
"/_stage
2/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
->
h
d
basenames
i
d
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
)
)
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment