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

3 files changed, 110 insertions, 92 deletions

diff --git a/testsuite/tests/asmcomp/Makefile b/testsuite/tests/asmcomp/Makefile
index c10b37e2f0..9d0f3ca8a3 100644
--- a/testsuite/tests/asmcomp/Makefile
+++ b/testsuite/tests/asmcomp/Makefile
@@ -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:
 
diff --git a/testsuite/tests/asmcomp/is_static.ml b/testsuite/tests/asmcomp/is_static.ml
index aac61fd875..76335af0f6 100644
--- a/testsuite/tests/asmcomp/is_static.ml
+++ b/testsuite/tests/asmcomp/is_static.ml
@@ -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)
diff --git a/testsuite/tests/asmcomp/is_static_flambda.ml b/testsuite/tests/asmcomp/is_static_flambda.ml
new file mode 100644
index 0000000000..6766fb8df1
--- /dev/null
+++ b/testsuite/tests/asmcomp/is_static_flambda.ml
@@ -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)