Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

split tests/asmcomp/is_static.ml into generic and flambda-specific parts

master
Damien Doligez 2016-02-02 15:14:06 +01:00
parent 8548fc02fe
commit 6d24bcfbce
3 changed files with 110 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
testsuite/tests/asmcomp/Makefile
View File

@ -46,6 +46,8 @@ lexcmm.ml: lexcmm.mll
MLCASES=optargs staticalloc bind_tuples is_static
ARGS_is_static=-I $(OTOPDIR)/byterun is_in_static_data.c
MLCASES_FLAMBDA=is_static_flambda
ARGS_is_static_flambda=-I $(OTOPDIR)/byterun is_in_static_data.c
CASES=fib tak quicksort quicksort2 soli \
arith checkbound tagged-fib tagged-integr tagged-quicksort tagged-tak
@ -69,7 +71,15 @@ skips:
one_ml:
@$(OCAMLOPT) $(ARGS_$(NAME)) -o $(NAME).exe $(NAME).ml && \
./$(NAME).exe $(FLAMBDA) && echo " => passed" || echo " => failed"
./$(NAME).exe && echo " => passed" || echo " => failed"
one_ml_flambda:
@if $(FLAMBDA); then \
$(OCAMLOPT) $(ARGS_$(NAME)) -o $(NAME).exe $(NAME).ml && \
./$(NAME).exe && echo " => passed" || echo " => failed"; \
else \
echo "=> skipped"; \
fi
one:
@$(call CC,$(NAME).out $(ARGS_$(NAME)) $(NAME).$(O) $(ARCH).$(O)) \
@ -105,6 +115,10 @@ tests: $(CASES:=.$(O))
printf " ... testing '$$c':"; \
$(MAKE) one_ml NAME=$$c; \
done
@for c in $(MLCASES_FLAMBDA); do \
printf " ... testing '$$c':"; \
$(MAKE) one_ml_flambda NAME=$$c; \
done
promote:

93
testsuite/tests/asmcomp/is_static.ml
View File

@ -1,7 +1,6 @@
(* Data that should be statically allocated by the compiler (all versions) *)
external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
let flambda = bool_of_string Sys.argv.(1)
let is_in_static_data_flambda x =
not flambda || is_in_static_data x
(* Basic constant blocks should be static *)
let block1 = (1,2)
@ -18,30 +17,6 @@ let f () =
let () = (f [@inlined never]) ()
(* Also after inlining *)
let g x =
let block = (1,x) in
assert(is_in_static_data_flambda block)
let () = (g [@inlined always]) 2
(* Toplevel immutable blocks should be static *)
let block3 = (Sys.opaque_identity 1, Sys.opaque_identity 2)
let () = assert(is_in_static_data_flambda block3)
(* Not being bound shouldn't prevent it *)
let () =
assert(is_in_static_data_flambda (Sys.opaque_identity 1, Sys.opaque_identity 2))
(* Only with rounds >= 2 currently !
(* Also after inlining *)
let h x =
let block = (Sys.opaque_identity 1,x) in
assert(is_in_static_data block)
let () = (h [@inlined always]) (Sys.opaque_identity 2)
*)
(* Closed functions should be static *)
let closed_function x = x + 1 (* + is a primitive, it cannot be in the closure *)
let () = assert(is_in_static_data closed_function)
@ -51,73 +26,9 @@ let almost_closed_function x =
(closed_function [@inlined never]) x
let () = assert(is_in_static_data almost_closed_function)
(* Recursive constant values should be static *)
let rec a = 1 :: b
and b = 2 :: a
let () =
assert(is_in_static_data_flambda a);
assert(is_in_static_data_flambda b)
(* Recursive constant functions should be static *)
let rec f1 a = g1 a
and g1 a = f1 a
let () =
assert(is_in_static_data f1);
assert(is_in_static_data g1)
(* And a mix *)
type e = E : 'a -> e
let rec f1 a = E (g1 a, l1)
and g1 a = E (f1 a, l2)
and l1 = E (f1, l2)
and l2 = E (g1, l1)
let () =
assert(is_in_static_data_flambda f1);
assert(is_in_static_data_flambda g1);
assert(is_in_static_data_flambda l1);
assert(is_in_static_data_flambda l2)
(* Also in functions *)
let i () =
let rec f1 a = E (g1 a, l1)
and g1 a = E (f1 a, l2)
and l1 = E (f1, l2)
and l2 = E (g1, l1) in
assert(is_in_static_data_flambda f1);
assert(is_in_static_data_flambda g1);
assert(is_in_static_data_flambda l1);
assert(is_in_static_data_flambda l2)
let () = (i [@inlined never]) ()
module type P = module type of Pervasives
(* Top-level modules should be static *)
let () = assert(is_in_static_data_flambda (module Pervasives:P))
(* Not constant let rec to test extraction to initialize_symbol *)
let r = ref 0
let rec a = (incr r; !r) :: b
and b = (incr r; !r) :: a
let next =
let r = ref 0 in
fun () -> incr r; !r
let () =
assert(is_in_static_data_flambda next)
(* Exceptions without arguments should be static *)
exception No_argument
let () = assert(is_in_static_data_flambda No_argument)
(* And also with constant arguments *)
exception Some_argument of string
let () = assert(is_in_static_data_flambda (Some_argument "some string"))
(* Even when exposed by inlining *)
let () =
let exn = try (failwith [@inlined always]) "some other string" with exn -> exn in
assert(is_in_static_data_flambda exn)

93
testsuite/tests/asmcomp/is_static_flambda.ml Normal file
View File

@ -0,0 +1,93 @@
(* Data that should be statically allocated by the compiler (flambda only) *)
external is_in_static_data : 'a -> bool = "caml_is_in_static_data"
(* Also after inlining *)
let g x =
let block = (1,x) in
assert(is_in_static_data block)
let () = (g [@inlined always]) 2
(* Toplevel immutable blocks should be static *)
let block3 = (Sys.opaque_identity 1, Sys.opaque_identity 2)
let () = assert(is_in_static_data block3)
(* Not being bound shouldn't prevent it *)
let () =
assert(is_in_static_data (Sys.opaque_identity 1, Sys.opaque_identity 2))
(* Only with rounds >= 2 currently !
(* Also after inlining *)
let h x =
let block = (Sys.opaque_identity 1,x) in
assert(is_in_static_data block)
let () = (h [@inlined always]) (Sys.opaque_identity 2)
*)
(* Recursive constant values should be static *)
let rec a = 1 :: b
and b = 2 :: a
let () =
assert(is_in_static_data a);
assert(is_in_static_data b)
(* And a mix *)
type e = E : 'a -> e
let rec f1 a = E (g1 a, l1)
and g1 a = E (f1 a, l2)
and l1 = E (f1, l2)
and l2 = E (g1, l1)
let () =
assert(is_in_static_data f1);
assert(is_in_static_data g1);
assert(is_in_static_data l1);
assert(is_in_static_data l2)
(* Also in functions *)
let i () =
let rec f1 a = E (g1 a, l1)
and g1 a = E (f1 a, l2)
and l1 = E (f1, l2)
and l2 = E (g1, l1) in
assert(is_in_static_data f1);
assert(is_in_static_data g1);
assert(is_in_static_data l1);
assert(is_in_static_data l2)
let () = (i [@inlined never]) ()
module type P = module type of Pervasives
(* Top-level modules should be static *)
let () = assert(is_in_static_data (module Pervasives:P))
(* Not constant let rec to test extraction to initialize_symbol *)
let r = ref 0
let rec a = (incr r; !r) :: b
and b = (incr r; !r) :: a
let next =
let r = ref 0 in
fun () -> incr r; !r
let () =
assert(is_in_static_data next)
(* Exceptions without arguments should be static *)
exception No_argument
let () = assert(is_in_static_data No_argument)
(* And also with constant arguments *)
exception Some_argument of string
let () = assert(is_in_static_data (Some_argument "some string"))
(* Even when exposed by inlining *)
let () =
let exn =
try (failwith [@inlined always]) "some other string" with exn -> exn
in
assert(is_in_static_data exn)