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
a90d5571
Commit
a90d5571
authored
Jun 03, 2014
by
Julien Lopez
Browse files
[TESTS][LAMBDA] Add some tests; fix environment in compute
parent
cced6ffb
Changes
2
Hide whitespace changes
Inline
Side-by-side
tests/lambda/src/compute.ml
View file @
a90d5571
...
...
@@ -156,7 +156,7 @@ and parse_abstr env l loc fun_name iface fv body =
let
t
=
type_of_ptype
ptype
in
let
brs
=
{
Typed
.
br_typ
=
t
;
br_accept
=
accept_type
t
;
br_branches
=
b
}
in
let
abstr
=
{
Typed
.
fun_name
=
fun_name
;
fun_iface
=
iface
;
fun_body
=
brs
;
fun_typ
=
fun_typ
;
fun_fv
=
fv
}
in
fun_typ
=
fun_typ
;
fun_fv
=
(
env
@
fv
)
}
in
env
,
l
,
{
Typed
.
exp_loc
=
caml_loc_to_cduce
loc
;
exp_typ
=
fun_typ
;
exp_descr
=
Typed
.
Abstraction
(
abstr
)
}
...
...
@@ -170,7 +170,7 @@ and make_patterns t fv d =
and
parse_branches
env
l
toptype
acc
btype
=
function
|
(
loc
,
p
,
e
)
::
rest
->
let
t
,
d
,
f
v
,
br_locals
,
br_used
=
parse_match_value
env
l
[]
toptype
p
in
let
t
,
d
,
en
v
,
br_locals
,
br_used
=
parse_match_value
env
l
[]
toptype
p
in
let
line
=
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
...
...
@@ -183,7 +183,7 @@ and parse_branches env l toptype acc btype = function
fname
line
cbegin
cend
;
make_patterns
t
[]
d
end
else
make_patterns
t
f
v
d
make_patterns
t
en
v
d
in
let
b
=
{
Typed
.
br_loc
=
caml_loc_to_cduce
loc
;
...
...
@@ -293,5 +293,5 @@ let to_typed expr =
Eval
.
register_op
"%"
(
arith_op
(
mod
));
Eval
.
register_op
"="
equal
;
Eval
.
register_op
"@"
concat
;
let
env
,
_
,
expr
=
_to_typed
Compile
.
empty_toplevel
Locals
.
empty
expr
in
env
,
expr
let
_
,
_
,
expr
=
_to_typed
[]
Locals
.
empty
expr
in
Compile
.
empty_toplevel
,
expr
tests/lambda/src/lambdaTests.ml
View file @
a90d5571
...
...
@@ -74,7 +74,7 @@ let tests_poly_abstr = [
"Test CDuce.lambda.identity_applied failed"
,
"Apply(PolyAbstraction(Dummy,Dummy,,,,Sel(Env(1),(`$A -> `$A),{ { `$A =
Int
} })
,Env(1)
),Const(2))"
,
} })),Const(2))"
,
"(fun f x : 'A : 'A -> x)[{A/Int}].2"
;
];;
...
...
@@ -109,7 +109,9 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
assert_equal
~
msg
:
"Test CDuce.runtime.abstr.let_simple failed"
~
printer
:
(
fun
x
->
x
)
"3"
(
run_test_eval
"let x : Int = 3 in x : Int"
);
assert_equal
~
msg
:
"Test CDuce.runtime.abstr.let_sum failed"
~
printer
:
(
fun
x
->
x
)
"5"
(
run_test_eval
"let x : Int = 2 in (let y : Int = 3 in (x + y) : Int) : Int"
);
assert_equal
~
msg
:
"Test CDuce.runtime.abstr.let_medium failed"
~
printer
:
(
fun
x
->
x
)
"2"
(
run_test_eval
"let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x)
...
...
@@ -131,6 +133,10 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
~
printer
:
(
fun
x
->
x
)
"Abstraction((Int,[ Char* ] -> [ Int Char* ]),Mono)"
(
run_test_eval
"fun f x : Int y : String : (Int*String) -> x,y"
);
assert_equal
~
msg
:
"Test CDuce.runtime.abstr.hard failed"
~
printer
:
(
fun
x
->
x
)
"Abstraction((Int -> Int -> Int,Int -> Int -> Int),Mono)"
(
run_test_eval
"fun (((Int -> Int) -> Int) -> (Int -> Int) -> Int) | x : ((Int -> Int) -> Int) -> (fun ((Int -> Int) -> Int) | y : (Int -> Int) -> x.y)"
);
);
"apply"
>::
(
fun
test_ctxt
->
...
...
@@ -215,6 +221,17 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
match x : ['A] with
| (el : 'A) :: [] -> f.el
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))"
);
assert_equal
~
msg
:
"Test CDuce.runtime.misc.map_even failed"
~
printer
:
(
fun
x
->
x
)
"Abstraction(([ `$A* ],[ `$B* ]),Sel(1,([ `$A* ] -> [ `$B* ]),Id))"
(
run_test_eval
"(fun map f : ('A->'B) x : ['A] : ['B] ->
match x : ['A] with
| (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
| [] -> []).(fun ((Int -> Bool) & ((!Int) -> (!Int)))
| x : Int -> (match (x % 2) : Int with
| 0 -> `true
| 1 -> `false)
| x : (!Int) -> x)"
);
assert_equal
~
msg
:
"Test CDuce.runtime.misc.map_even_simple failed"
~
printer
:
(
fun
x
->
x
)
"(
\"
hey
\"
,(Atom(false),Atom(nil),Mono),Mono)"
...
...
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