New pattern instrumenter; avoids as-patterns

test/instrument/control/function.t

@@ -50,3 +50,45 @@ Expressions in cases are in tail position.
     | () ->
         ___bisect_visit___ 0;
         print_endline "foo"
+
+
+Or-pattern.
+
+  $ bash ../test.sh <<'EOF'
+  > let _ = function None | Some _ -> print_endline "foo"
+  > EOF
+  let _ =
+   fun ___bisect_matched_value___ ->
+    match ___bisect_matched_value___ with
+    | None | Some _ ->
+        (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+           ___bisect_matched_value___
+         with
+        | None ->
+            ___bisect_visit___ 0;
+            ()
+        | Some _ ->
+            ___bisect_visit___ 1;
+            ()
+        | _ -> ());
+        print_endline "foo"
+
+
+Or-pattern with polymorphic variants.
+
+  $ bash ../test.sh <<'EOF'
+  > let _ = function `A | `B -> print_endline "foo"
+  > EOF
+  let _ = function
+    | (`A | `B) as ___bisect_matched_value___ ->
+        (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+           ___bisect_matched_value___
+         with
+        | `A ->
+            ___bisect_visit___ 0;
+            ()
+        | `B ->
+            ___bisect_visit___ 1;
+            ()
+        | _ -> ());
+        print_endline "foo"

test/instrument/control/try.t

@@ -62,3 +62,26 @@ whole expression is in tail position.
     with _ ->
       ___bisect_visit___ 3;
       print_endline "bar"
+
+
+Or-pattern.
+
+  $ bash ../test.sh <<'EOF'
+  > let _ =
+  >   try ()
+  >   with Exit | End_of_file -> ()
+  > EOF
+  let _ =
+    try ()
+    with (Exit | End_of_file) as ___bisect_matched_value___ ->
+      (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+         ___bisect_matched_value___
+       with
+      | Exit ->
+          ___bisect_visit___ 0;
+          ()
+      | End_of_file ->
+          ___bisect_visit___ 1;
+          ()
+      | _ -> ());
+      ()

test/instrument/pattern/exception.t

@@ -8,9 +8,6 @@ Exception or-patterns.
   > EOF
   let _ =
     match () with
-    | () ->
-        ___bisect_visit___ 0;
-        ()
     | exception ((Exit | Failure _) as ___bisect_matched_value___) ->
         (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
            ___bisect_matched_value___
@@ -23,25 +20,54 @@ Exception or-patterns.
             ()
         | _ -> ());
         ()
+    | () ->
+        ___bisect_visit___ 0;
+        ()
 
 
-Mixed value-exception cases trigger an alternative instrumentation strategy,
-which is only correct because such cases do not use when-guards.
+Mixed value-exception cases are partitioned. Order is preserved. Case are
+factored out into functions, whose parameters are the bound variables of the
+patterns.
 
   $ bash ../test.sh <<'EOF'
   > let _ =
   >   match Exit with
-  >   | x | exception (Exit as x) -> ignore x; print_endline "foo"
+  >   | Exit as x | exception (Exit as x) -> ignore x; print_endline "foo"
+  >   | End_of_file as y | exception (End_of_file | Failure _ as y) ->
+  >     ignore y; print_endline "bar"
+  >   | _ -> print_endline "baz"
   > EOF
   let _ =
     let ___bisect_case_0___ x () =
       ignore x;
       ___bisect_post_visit___ 0 (print_endline "foo")
+    and ___bisect_case_1___ y () =
+      ignore y;
+      ___bisect_post_visit___ 1 (print_endline "bar")
     in
     match Exit with
-    | x ->
-        ___bisect_visit___ 1;
-        ___bisect_case_0___ x ()
     | exception (Exit as x) ->
-        ___bisect_visit___ 2;
+        ___bisect_visit___ 4;
+        ___bisect_case_0___ x ()
+    | exception ((End_of_file | Failure _) as y as ___bisect_matched_value___) ->
+        (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+           ___bisect_matched_value___
+         with
+        | End_of_file as y ->
+            ___bisect_visit___ 6;
+            ()
+        | Failure _ as y ->
+            ___bisect_visit___ 7;
+            ()
+        | _ -> ());
+        ___bisect_case_1___ y ()
+    | Exit as x ->
+        ___bisect_visit___ 3;
         ___bisect_case_0___ x ()
+    | End_of_file as y ->
+        ___bisect_visit___ 5;
+        ___bisect_case_1___ y ()
+    | _ ->
+        ___bisect_visit___ 8;
+        ___bisect_post_visit___ 2 (print_endline "baz")
+  $ dune build ./test.bc --instrument-with bisect_ppx

test/instrument/pattern/nary.t

@@ -43,28 +43,30 @@ Record.
   
   let _ =
     match { a = true; b = false } with
-    | { a = true | false; b = true | false } as ___bisect_matched_value___ ->
-        (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
-           ___bisect_matched_value___
-         with
-        | { a = true; b = true } ->
-            ___bisect_visit___ 2;
-            ___bisect_visit___ 1;
-            ()
-        | { a = true; b = false } ->
-            ___bisect_visit___ 3;
-            ___bisect_visit___ 1;
-            ()
-        | { a = false; b = true } ->
-            ___bisect_visit___ 2;
-            ___bisect_visit___ 4;
-            ()
-        | { a = false; b = false } ->
-            ___bisect_visit___ 3;
-            ___bisect_visit___ 4;
-            ()
-        | _ -> ());
-        ___bisect_post_visit___ 0 (print_endline "foo")
+    | ___bisect_matched_value___ -> (
+        match ___bisect_matched_value___ with
+        | { a = true | false; b = true | false } ->
+            (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+               ___bisect_matched_value___
+             with
+            | { a = true; b = true } ->
+                ___bisect_visit___ 2;
+                ___bisect_visit___ 1;
+                ()
+            | { a = true; b = false } ->
+                ___bisect_visit___ 3;
+                ___bisect_visit___ 1;
+                ()
+            | { a = false; b = true } ->
+                ___bisect_visit___ 2;
+                ___bisect_visit___ 4;
+                ()
+            | { a = false; b = false } ->
+                ___bisect_visit___ 3;
+                ___bisect_visit___ 4;
+                ()
+            | _ -> ());
+            ___bisect_post_visit___ 0 (print_endline "foo"))
 
 
 Array.

test/instrument/pattern/row.t

@@ -0,0 +1,33 @@
+Or-pattern instrumentation does not prevent row type generalization.
+
+  $ bash ../test.sh <<'EOF'
+  > type t = [ `A | `B ]
+  > module M :
+  > sig
+  >   val f : [< t ] -> unit
+  > end =
+  > struct
+  >   let f = function
+  >     | `A | `B -> ()
+  > end
+  > EOF
+  type t = [ `A | `B ]
+  
+  module M : sig
+    val f : [< t ] -> unit
+  end = struct
+    let f = function
+      | (`A | `B) as ___bisect_matched_value___ ->
+          (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+             ___bisect_matched_value___
+           with
+          | `A ->
+              ___bisect_visit___ 0;
+              ()
+          | `B ->
+              ___bisect_visit___ 1;
+              ()
+          | _ -> ());
+          ()
+  end
+  $ dune build ./test.bc --instrument-with bisect_ppx

test/instrument/pattern/when.t

@@ -37,9 +37,6 @@ the guard, rather than the pattern.
   > EOF
   let _ =
     match () with
-    | () ->
-        ___bisect_visit___ 1;
-        ()
     | exception ((Exit | Failure _) as ___bisect_matched_value___)
       when (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
               ___bisect_matched_value___
@@ -55,3 +52,6 @@ the guard, rather than the pattern.
            true ->
         ___bisect_visit___ 4;
         ()
+    | () ->
+        ___bisect_visit___ 1;
+        ()

test/instrument/recent/exception-pattern.t

@@ -8,9 +8,6 @@ Exception patterns under or-pattern.
   > EOF
   let _ =
     match () with
-    | () ->
-        ___bisect_visit___ 0;
-        ()
     | (exception (Exit as ___bisect_matched_value___))
     | (exception (Failure _ as ___bisect_matched_value___)) ->
         (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
@@ -24,6 +21,9 @@ Exception patterns under or-pattern.
             ()
         | _ -> ());
         ()
+    | () ->
+        ___bisect_visit___ 0;
+        ()
 
 
 Exception pattern under type constraint.
@@ -36,9 +36,6 @@ Exception pattern under type constraint.
   > EOF
   let _ =
     match () with
-    | () ->
-        ___bisect_visit___ 0;
-        ()
     | ((exception ((Exit | Failure _) as ___bisect_matched_value___)) : unit) ->
         (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
            ___bisect_matched_value___
@@ -51,3 +48,6 @@ Exception pattern under type constraint.
             ()
         | _ -> ());
         ()
+    | () ->
+        ___bisect_visit___ 0;
+        ()

test/instrument/recent/gadt.t

@@ -0,0 +1,55 @@
+GADT. See https://github.com/aantron/bisect_ppx/issues/325.
+
+  $ bash ../test.sh <<'EOF'
+  > type _ t = A : unit t | B : bool t
+  > let f : type a. a t -> unit = fun x ->
+  >   match x with
+  >   | A | B -> ()
+  > EOF
+  type _ t = A : unit t | B : bool t
+  
+  let f : type a. a t -> unit =
+   fun x ->
+    ___bisect_visit___ 2;
+    match x with
+    | ___bisect_matched_value___ -> (
+        match ___bisect_matched_value___ with
+        | A | B ->
+            (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+               ___bisect_matched_value___
+             with
+            | A ->
+                ___bisect_visit___ 0;
+                ()
+            | B ->
+                ___bisect_visit___ 1;
+                ()
+            | _ -> ());
+            ())
+  $ dune build ./test.bc --instrument-with bisect_ppx
+
+
+With function.
+
+  $ bash ../test.sh <<'EOF'
+  > type _ t = A : unit t | B : bool t
+  > let f : type a. a t -> unit = function
+  >   | A | B -> ()
+  > EOF
+  type _ t = A : unit t | B : bool t
+  
+  let f : type a. a t -> unit =
+   fun ___bisect_matched_value___ ->
+    match ___bisect_matched_value___ with
+    | A | B ->
+        (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
+           ___bisect_matched_value___
+         with
+        | A ->
+            ___bisect_visit___ 0;
+            ()
+        | B ->
+            ___bisect_visit___ 1;
+            ()
+        | _ -> ());
+        ()

test/instrument/recent/pattern-open.t

@@ -13,9 +13,6 @@ Or-pattern under local open.
   
   let _ =
     match () with
-    | () ->
-        ___bisect_visit___ 0;
-        ()
     | M.((exception ((E | Exit) as ___bisect_matched_value___))) ->
         (match[@ocaml.warning "-4-8-9-11-26-27-28-33"]
            ___bisect_matched_value___
@@ -28,3 +25,6 @@ Or-pattern under local open.
             ()
         | _ -> ());
         ()
+    | () ->
+        ___bisect_visit___ 0;
+        ()