Add more test cases

Some of those cases showcase the differences between the native and
bytecode toplevel in 4.11 and will be useful to determine if they have
been fixed on trunk!

Signed-off-by: Nathan Rebours <nathan.p.rebours@gmail.com>

tests/bin/gen_rules.ml

@@ -6,10 +6,11 @@ let pr_output_rule ~mode basename =
   Printf.printf {|
 (rule
  (action
-  (with-outputs-to %s.%s
-   (run bytetop %%{dep:%s.ml}))))
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to %s.%s
+    (run %stop %%{dep:%s.ml})))))
 |}
-    basename mode basename
+    basename mode mode basename
 
 let pr_diff_rule ~mode ~ref basename =
   Printf.printf {|

tests/dune

@@ -1,4 +1,6 @@
 (rule
+ (deps
+   (source_tree .))
  (action
   (with-stdout-to dune.gen
    (run ./bin/gen_rules.exe))))

tests/dune.inc

@@ -1,18 +1,87 @@
 
 (rule
  (action
-  (with-outputs-to one_plus_one.byte
-   (run bytetop %{dep:one_plus_one.ml}))))
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to hello_world.byte
+    (run bytetop %{dep:hello_world.ml})))))
 
 (rule
  (action
-  (with-outputs-to one_plus_one.nat
-   (run bytetop %{dep:one_plus_one.ml}))))
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to hello_world.nat
+    (run nattop %{dep:hello_world.ml})))))
 
 (rule
  (action
-  (with-outputs-to one_plus_one.jit
-   (run bytetop %{dep:one_plus_one.ml}))))
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to hello_world.jit
+    (run jittop %{dep:hello_world.ml})))))
+
+(rule
+ (alias bytetest)
+ (action
+  (diff hello_world.expected hello_world.byte)))
+
+(rule
+ (alias nattest)
+ (action
+  (diff hello_world.byte hello_world.nat)))
+
+(rule
+ (alias jittest)
+ (action
+  (diff hello_world.nat hello_world.jit)))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to local_exc.byte
+    (run bytetop %{dep:local_exc.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to local_exc.nat
+    (run nattop %{dep:local_exc.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to local_exc.jit
+    (run jittop %{dep:local_exc.ml})))))
+
+(rule
+ (alias bytetest)
+ (action
+  (diff local_exc.expected local_exc.byte)))
+
+(rule
+ (alias nattest)
+ (action
+  (diff local_exc.byte local_exc.nat)))
+
+(rule
+ (alias jittest)
+ (action
+  (diff local_exc.nat local_exc.jit)))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to one_plus_one.byte
+    (run bytetop %{dep:one_plus_one.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to one_plus_one.nat
+    (run nattop %{dep:one_plus_one.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to one_plus_one.jit
+    (run jittop %{dep:one_plus_one.ml})))))
 
 (rule
  (alias bytetest)
@@ -29,6 +98,72 @@
  (action
   (diff one_plus_one.nat one_plus_one.jit)))
 
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to preserve_type_vars.byte
+    (run bytetop %{dep:preserve_type_vars.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to preserve_type_vars.nat
+    (run nattop %{dep:preserve_type_vars.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to preserve_type_vars.jit
+    (run jittop %{dep:preserve_type_vars.ml})))))
+
+(rule
+ (alias bytetest)
+ (action
+  (diff preserve_type_vars.expected preserve_type_vars.byte)))
+
+(rule
+ (alias nattest)
+ (action
+  (diff preserve_type_vars.byte preserve_type_vars.nat)))
+
+(rule
+ (alias jittest)
+ (action
+  (diff preserve_type_vars.nat preserve_type_vars.jit)))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to simple_fun.byte
+    (run bytetop %{dep:simple_fun.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to simple_fun.nat
+    (run nattop %{dep:simple_fun.ml})))))
+
+(rule
+ (action
+  (with-accepted-exit-codes (or 0 1 125)
+   (with-outputs-to simple_fun.jit
+    (run jittop %{dep:simple_fun.ml})))))
+
+(rule
+ (alias bytetest)
+ (action
+  (diff simple_fun.expected simple_fun.byte)))
+
+(rule
+ (alias nattest)
+ (action
+  (diff simple_fun.byte simple_fun.nat)))
+
+(rule
+ (alias jittest)
+ (action
+  (diff simple_fun.nat simple_fun.jit)))
+
 (alias
  (name runtest)
  (deps

tests/hello_world.expected

@@ -0,0 +1,2 @@
+Hello world!
+- : unit = ()

tests/hello_world.ml

@@ -0,0 +1 @@
+Printf.printf "Hello world!\n";;

tests/local_exc.expected

@@ -0,0 +1 @@
+Exception: X.Test.

tests/local_exc.ml

@@ -0,0 +1,5 @@
+module X = struct
+  exception Test
+end
+
+let () = raise X.Test;;

tests/preserve_type_vars.expected

@@ -0,0 +1,3 @@
+module A :
+  sig type ('foo, 'bar) t val get_foo : ('foo, 'a) t -> 'foo option end
+- : ('foo, 'a) A.t -> 'foo option = <fun>

tests/preserve_type_vars.ml

@@ -0,0 +1,17 @@
+module A : sig 
+  type ('foo, 'bar) t
+
+  val get_foo : ('foo, _) t -> 'foo option
+end = struct
+  type ('foo, 'bar) t =
+    | Foo of 'foo
+    | Bar of 'bar
+
+  let get_foo = function
+    | Foo foo -> Some foo
+    | Bar _ -> None
+end
+;;
+
+A.get_foo
+;;

tests/simple_fun.expected

@@ -0,0 +1 @@
+- : float = 3.

tests/simple_fun.ml

@@ -0,0 +1 @@
+let [@inline never] f x = x +. 2.0 in f 1.0;;