Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
Menu
Open sidebar
cduce
cduce
Commits
ae56a9e0
Commit
ae56a9e0
authored
Apr 28, 2014
by
Julien Lopez
Browse files
[TESTS][LAMBDA] Add test generator (to fix)
parent
9d95ac98
Changes
10
Hide whitespace changes
Inline
Side-by-side
tests/lambda/GRAMMAR
View file @
ae56a9e0
expr = id
| integer
| `true
| `false
|
"
`true
"
|
"
`false
"
| string
| abstr
| "let" string ":" type_id "=" expr "in" expr ":" type_id
...
...
@@ -16,17 +16,21 @@ expr = id
| "(" expr ")"
| "[" listexpr "]"
| "match" expr ":" type_id "with" "|" match_value "->" expr branches
;;
sigma = (* empty *)
| ";" id "/" type_id
;;
listexpr = (* empty *)
| expr
| listexpr ";" listexpr
;;
abstr = "fun" id id ":" type_id params ":" type_id "->" expr
| "fun" "_" id ":" type_id params ":" type_id "->" expr
| "fun" type_id "|" match_value "->" expr branches
;;
match_value = id ":" type_id
| integer
...
...
@@ -34,27 +38,32 @@ match_value = id ":" type_id
| match_value "," match_value
| match_value "::" match_value
| "(" match_value ")"
;;
params = (* empty *)
| id ":" type_id params
;;
branches = (* empty *)
| "|" match_value "->" expr branches
;;
(* Note: The first character of an id is lower case (or '_'), the first
character of a type is upper case *)
id = [a-z_][A-Za-z0-9_]*
id = LIDENT (* [a-z_][A-Za-z0-9_]* *)
;;
type_id =
[A-Z][A-Za-z0-9_]*
| "'"
[A-Z][A-Za-z0-9_]*
"{" id "/" type_id sigma "}"
type_id =
LIDENT
| "'"
LIDENT
"{" id "/" type_id sigma "}"
| "[" complex_type_id "]"
| "(" complex_type_id ")"
;;
complex_type_id = [A-Z][A-Za-z0-9_]*
complex_type_id =
UIDENT (*
[A-Z][A-Za-z0-9_]*
*)
(* One must precise a set of type substitutions on a type variable, at least a
empty one : α = 'A{} *)
| "'"
[A-Z][A-Za-z0-9_]*
"{" id "/" type_id sigma "}"
| "'"
UIDENT
"{" id "/" type_id sigma "}"
| complex_type_id "*" complex_type_id
| complex_type_id "|" complex_type_id
| complex_type_id "&" complex_type_id
...
...
@@ -62,5 +71,6 @@ complex_type_id = [A-Z][A-Za-z0-9_]*
| complex_type_id "->" complex_type_id
| "[" complex_type_id "]"
| "(" complex_type_id ")"
;;
integer = [0-9]+
integer =
INTEGER (*
[0-9]+
*)
tests/lambda/Makefile
View file @
ae56a9e0
...
...
@@ -25,7 +25,7 @@ RM ?= rm -f
OUT
?=
main.native
OUTDEBUG
?=
main.byte
.PHONY
:
clean _import
.PHONY
:
clean _import
tests
all
:
_import
$(COMPILER)
-use-ocamlfind
$(OUT)
...
...
@@ -33,6 +33,9 @@ all: _import
debug
:
_import
$(COMPILER)
-use-ocamlfind
-tag
debug
$(OUTDEBUG)
tests
:
make
-C
tests
_import
:
@
echo
-n
"Copying external files..."
@
test
-d
$(EXTDIR)
||
mkdir
$(EXTDIR)
...
...
@@ -40,5 +43,6 @@ _import:
@
echo
"done"
clean
:
make
-C
tests clean
$(COMPILER)
-clean
test
$(EXTDIR)
=
"src"
||
test
$(EXTDIR)
=
"."
||
$(RM)
-r
$(EXTDIR)
tests/lambda/src/main.ml
View file @
ae56a9e0
...
...
@@ -306,7 +306,6 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
~
printer
:
(
fun
x
->
x
)
"(2, 5, {})"
(
run_test_eval
"(fun tail x : [Int] : [Int] -> match x : [Int] with
| (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]"
);
(* TODO: Fix this test, we need to define [] aka `nil *)
assert_equal
~
msg
:
"Test CDuce.runtime.list.last failed"
~
printer
:
(
fun
x
->
x
)
"7"
(
run_test_eval
"(fun f x : [Int] : [Int] -> match x : [Int] with
...
...
tests/lambda/tests/Makefile
0 → 100644
View file @
ae56a9e0
COMPILER
?=
ocamlbuild
SRCDIR
?=
src
RM
?=
rm
-f
OUT
?=
gen_test.native
OUTDEBUG
?=
gen_test.byte
.PHONY
:
clean
all
:
$(COMPILER)
-use-ocamlfind
$(OUT)
debug
:
$(COMPILER)
-use-ocamlfind
-tag
debug
$(OUTDEBUG)
clean
:
$(COMPILER)
-clean
tests/lambda/tests/_tags
0 → 100644
View file @
ae56a9e0
<src>: include
<src/parse*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/compute*>: pp(camlp4orf.opt), package(camlp4.lib)
<src/gen_test*>: pp(camlp4orf.opt), package(camlp4.lib)
tests/lambda/tests/src/compute.ml
0 → 100644
View file @
ae56a9e0
open
Parse
open
Camlp4
.
PreCast
module
Rules
=
Map
.
Make
(
String
)
let
rules
=
ref
Rules
.
empty
let
arules
=
ref
[
||
]
exception
Error
let
rec
init
l
=
match
l
with
|
Rule
(
_
,
name
,
tokens
)
::
rest
->
rules
:=
Rules
.
add
name
tokens
!
rules
;
arules
:=
Array
.
append
!
arules
[
|
name
|
];
init
rest
|
[]
->
()
let
rec
get_state
nb
=
function
|
state
::
rest
->
if
nb
!=
0
then
get_state
(
nb
-
1
)
rest
else
state
|
_
->
assert
false
let
rec
g_ident
nb
res
=
if
nb
=
0
then
res
else
let
rand
=
Random
.
int
63
in
let
res
=
res
^
(
if
rand
<
26
then
String
.
make
1
(
char_of_int
(
int_of_char
'
a'
+
rand
))
else
if
rand
<
52
then
String
.
make
1
(
char_of_int
(
int_of_char
'
A'
+
rand
))
else
if
rand
<
62
then
String
.
make
1
(
char_of_int
(
int_of_char
'
0
'
+
rand
))
else
"_"
)
in
g_ident
(
nb
-
1
)
res
let
g_lident
nb
res
=
if
nb
=
0
then
res
else
let
rand
=
Random
.
int
27
in
let
res
=
res
^
(
if
rand
=
26
then
"_"
else
String
.
make
1
(
char_of_int
(
int_of_char
'
a'
+
rand
)))
in
g_ident
(
nb
-
1
)
res
let
g_uident
nb
res
=
if
nb
=
0
then
res
else
let
rand
=
Random
.
int
26
in
let
res
=
res
^
(
String
.
make
1
(
char_of_int
(
int_of_char
'
A'
+
rand
)))
in
g_ident
(
nb
-
1
)
res
let
rec
g_token
=
function
|
RefRule
(
loc
,
name
)
->
let
states
=
try
Rules
.
find
name
!
rules
with
Not_found
->
let
l
=
Loc
.
start_line
loc
in
let
cbegin
=
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
in
let
cend
=
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
Printf
.
eprintf
"File %s, line %d, characters %d-%d:Unknown rule %s
\n
"
(
Loc
.
file_name
loc
)
l
cbegin
cend
name
;
raise
Error
in
g_states
""
states
|
String
(
_
,
s
)
->
s
|
Special
(
loc
,
spe
)
->
match
spe
with
|
"LIDENT"
->
g_lident
3
""
|
"UIDENT"
->
g_uident
3
""
|
"INTEGER"
->
string_of_int
(
Random
.
int
1000
)
|
_
->
let
l
=
Loc
.
start_line
loc
in
let
cbegin
=
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
in
let
cend
=
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
Printf
.
eprintf
"File %s, line %d, characters %d-%d:Unknown special keyword %s
\n
"
(
Loc
.
file_name
loc
)
l
cbegin
cend
spe
;
raise
Error
and
g_tokens
res
=
function
|
token
::
rest
->
g_tokens
(
res
^
(
g_token
token
))
rest
|
[]
->
res
and
g_states
res
states
=
let
max_rand
=
List
.
length
states
in
let
rand
=
Random
.
int
(
max_rand
+
1
)
in
if
rand
!=
max_rand
then
g_tokens
res
(
get_state
rand
states
)
else
res
let
g_rule
res
=
Random
.
self_init
()
;
let
max_rand
=
Rules
.
cardinal
!
rules
in
let
rand
=
Random
.
int
(
max_rand
+
1
)
in
if
rand
!=
max_rand
then
g_states
res
(
Rules
.
find
!
arules
.
(
rand
)
!
rules
)
else
res
let
get_test
()
=
g_rule
""
tests/lambda/tests/src/compute.mli
0 → 100644
View file @
ae56a9e0
exception
Error
val
init
:
Parse
.
expr
list
->
unit
val
get_test
:
unit
->
string
tests/lambda/tests/src/gen_test.ml
0 → 100644
View file @
ae56a9e0
open
Printf
open
Parse
open
Camlp4
.
PreCast
let
load_file
f
=
let
ic
=
open_in
f
in
let
n
=
in_channel_length
ic
in
let
s
=
String
.
create
n
in
really_input
ic
s
0
n
;
close_in
ic
;
s
;;
let
str
,
file
=
if
Array
.
length
Sys
.
argv
>
1
then
load_file
Sys
.
argv
.
(
1
)
,
Sys
.
argv
.
(
1
)
else
(
eprintf
"Fatal error: No input file
\n
"
;
exit
1
)
in
try
let
grammar
=
ExprParser
.
of_string
str
file
in
Compute
.
init
grammar
;
let
ex
=
Compute
.
get_test
()
in
printf
"%s
\n
"
ex
with
|
Compute
.
Error
->
exit
3
|
Loc
.
Exc_located
(
loc
,
exn
)
->
let
l
=
Loc
.
start_line
loc
in
let
cbegin
=
Loc
.
start_off
loc
-
Loc
.
start_bol
loc
in
let
cend
=
Loc
.
stop_off
loc
-
Loc
.
start_bol
loc
in
eprintf
"File %s, line %d, characters %d-%d:
\n
"
(
Loc
.
file_name
loc
)
l
cbegin
cend
;
raise
exn
|
e
->
eprintf
"Runtime error.
\n
"
;
raise
e
tests/lambda/tests/src/parse.ml
0 → 100644
View file @
ae56a9e0
open
Camlp4
.
PreCast
type
expr
=
|
Rule
of
Loc
.
t
*
string
*
token
list
list
and
token
=
|
RefRule
of
Loc
.
t
*
string
|
String
of
Loc
.
t
*
string
|
Special
of
Loc
.
t
*
string
module
ExprParser
=
struct
let
exp_eoi
=
Gram
.
Entry
.
mk
"exp_eoi"
EXTEND
Gram
GLOBAL
:
exp_eoi
;
exp_eoi
:
[[
e
=
LIST0
expression
SEP
";;"
;
`EOI
->
e
]];
expression
:
[[
x
=
LIDENT
;
"="
;
l
=
LIST1
(
LIST0
token
)
SEP
"|"
->
Rule
(
_loc
,
x
,
l
)
]];
token
:
[
"refrule"
NONA
[
x
=
LIDENT
->
RefRule
(
_loc
,
x
)
]
|
"string"
NONA
[
s
=
STRING
->
String
(
_loc
,
s
)
]
|
"special"
NONA
[
x
=
UIDENT
->
Special
(
_loc
,
x
)
]
];
END
;;
let
of_string
s
file
=
Gram
.
parse_string
exp_eoi
(
Loc
.
mk
file
)
s
let
of_string_no_file
s
=
Gram
.
parse_string
exp_eoi
Loc
.
ghost
s
end
tests/lambda/tests/src/parse.mli
0 → 100644
View file @
ae56a9e0
open
Camlp4
.
PreCast
type
expr
=
|
Rule
of
Loc
.
t
*
string
*
token
list
list
and
token
=
|
RefRule
of
Loc
.
t
*
string
|
String
of
Loc
.
t
*
string
|
Special
of
Loc
.
t
*
string
module
ExprParser
:
sig
val
of_string
:
string
->
string
->
expr
list
val
of_string_no_file
:
string
->
expr
list
end
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