better spread out and document tests

ocaml/testsuite/tests/pattern-guards/exn_patterns.ml

@@ -0,0 +1,119 @@
+(* TEST
+   * expect *)
+
+(* Test interaction of pattern guards with exception patterns. *)
+
+(* Test behavior of pattern guards that only match exception patterns. *)
+
+let no_value_clauses f x =
+  match x with
+  | Some x when f x match exception e -> Error e
+  | Some x -> Ok (f x)
+  | None -> Error (Failure "x is None")
+;;
+[%%expect{|
+val no_value_clauses : ('a -> 'b) -> 'a option -> ('b, exn) result = <fun>
+|}];;
+
+let f x = 100 / x;;
+[%%expect{|
+val f : int -> int = <fun>
+|}];;
+
+no_value_clauses f None;;
+[%%expect{|
+- : (int, exn) result = Error (Failure "x is None")
+|}];;
+no_value_clauses f (Some 0);;
+[%%expect{|
+- : (int, exn) result = Error Division_by_zero
+|}];;
+no_value_clauses f (Some 5);;
+[%%expect{|
+- : (int, exn) result = Ok 20
+|}];;
+
+(* Test behavior of pattern guards matching empty variants with exception
+   patterns. *)
+
+type void = |;;
+[%%expect{|
+type void = |
+|}];;
+
+let prove_false () : void = failwith "qed";;
+[%%expect{|
+val prove_false : unit -> void = <fun>
+|}];;
+
+let guard_matching_empty_variant = function
+  | None when prove_false () match exception (Failure str) -> "failed: " ^ str
+  | None -> "proved false!"
+  | Some x -> x
+;;
+[%%expect{|
+val guard_matching_empty_variant : string option -> string = <fun>
+|}];;
+
+guard_matching_empty_variant None;;
+[%%expect{|
+- : string = "failed: qed"
+|}];;
+guard_matching_empty_variant (Some "foo");;
+[%%expect{|
+- : string = "foo"
+|}];;
+
+(* Correctness test for pattern guards with mixed value and exception
+   patterns. *)
+
+module M : sig
+  type 'a t
+
+  val empty : 'a t
+  val add : int -> 'a -> 'a t -> 'a t
+  val find : int -> 'a t -> 'a
+end = Map.Make (Int);;
+[%%expect{|
+module M :
+  sig
+    type 'a t
+    val empty : 'a t
+    val add : int -> 'a -> 'a t -> 'a t
+    val find : int -> 'a t -> 'a
+  end
+|}];;
+
+let name_map = M.empty |> M.add 0 "Fred" |> M.add 4 "Barney";;
+[%%expect{|
+val name_map : string M.t = <abstr>
+|}];;
+
+
+let say_hello_catching_exns id name_map =
+  match id with
+  | Some id when M.find id name_map match "Barney" | exception _ ->
+      "Hello, Barney"
+  | None | Some _ -> "Hello, Fred"
+;;
+[%%expect{|
+val say_hello_catching_exns : int option -> string M.t -> string = <fun>
+|}];;
+
+say_hello_catching_exns (Some 0) name_map;;
+[%%expect{|
+- : string = "Hello, Fred"
+|}];;
+say_hello_catching_exns (Some 2) name_map;;
+[%%expect{|
+- : string = "Hello, Barney"
+|}];;
+say_hello_catching_exns (Some 4) name_map;;
+[%%expect{|
+- : string = "Hello, Barney"
+|}];;
+say_hello_catching_exns None name_map;;
+[%%expect{|
+- : string = "Hello, Fred"
+|}];;
+

ocaml/testsuite/tests/pattern-guards/gadts.ml

@@ -0,0 +1,32 @@
+(* TEST
+   * expect *)
+
+(* Test pattern guard inward propagation of GADT type information. *)
+
+type ('a, 'b) eq = Eq : ('a, 'a) eq;;
+[%%expect{|
+type ('a, 'b) eq = Eq : ('a, 'a) eq
+|}];;
+
+let in_pattern_guard (type a b) (eq : (a, b) eq) (compare : a -> a -> int)
+                     (x : a) (y : b) =
+  match eq with
+  | Eq when compare x y match 0 -> true
+  | _ -> false
+;;
+[%%expect{|
+val in_pattern_guard : ('a, 'b) eq -> ('a -> 'a -> int) -> 'a -> 'b -> bool =
+  <fun>
+|}];;
+
+let from_pattern_guard (type a b) (eqs : (a, b) eq option list)
+                       (compare : a -> a -> int) (x : a) (y : b) =
+  match eqs with
+  | eq_opt :: _ when eq_opt match Some Eq -> compare x y
+  | _ -> 0
+;;
+[%%expect{|
+val from_pattern_guard :
+  ('a, 'b) eq option list -> ('a -> 'a -> int) -> 'a -> 'b -> int = <fun>
+|}];;
+

ocaml/testsuite/tests/pattern-guards/jane_test.ml

@@ -11,7 +11,7 @@ let pattern_guard_returns_local f x =
     | [] -> 0
     | [ _ ] -> one
     | [ _; _ ] -> 2
-  )
+    )
   | _ -> 3
 ;;
 [%%expect{|
@@ -26,10 +26,10 @@ let pattern_guard_doesnt_return_local f x =
   let local_ one = 1 in
   match x with
   | Some x when one match (
-    | 0 -> 0
-    | 1 -> 1
-    | 2 -> 2
-  )
+      | 0 -> 0
+      | 1 -> 1
+      | 2 -> 2
+    )
   | _ -> 3
 ;;
 [%%expect{|

ocaml/testsuite/tests/pattern-guards/nested_guards.ml

@@ -0,0 +1,121 @@
+(* TEST
+   * expect *)
+
+(* Tests behavior of nested pattern guards, i.e. pattern guards whose cases have
+   patterns that are themselves guarded. *)
+
+(* Nested single-way pattern guards. *)
+
+let nested_singleway f g h ~default = function
+  | Some x
+      when f x match Some y
+      when g y match Some z
+      when h z match Some a ->
+      a
+  | _ -> default
+;;
+[%%expect{|
+val nested_singleway :
+  ('a -> 'b option) ->
+  ('b -> 'c option) -> ('c -> 'd option) -> default:'d -> 'a option -> 'd =
+  <fun>
+|}];;
+
+let collatz = function
+  | 1 -> None
+  | n -> if n mod 2 = 0 then Some (n / 2) else Some (3 * n + 1)
+;;
+[%%expect{|
+val collatz : int -> int option = <fun>
+|}];;
+
+nested_singleway collatz collatz collatz ~default:~-1 None;;
+[%%expect{|
+- : int = -1
+|}];;
+nested_singleway collatz collatz collatz ~default:~-1 (Some 1);;
+[%%expect{|
+- : int = -1
+|}];;
+nested_singleway collatz collatz collatz ~default:~-1 (Some 2);;
+[%%expect{|
+- : int = -1
+|}];;
+nested_singleway collatz collatz collatz ~default:~-1 (Some 3);;
+[%%expect{|
+- : int = 16
+|}];;
+nested_singleway collatz collatz collatz ~default:~-1 (Some 4);;
+[%%expect{|
+- : int = -1
+|}];;
+nested_singleway collatz collatz collatz ~default:~-1 (Some 8);;
+[%%expect{|
+- : int = 1
+|}];;
+
+(* Nested multiway pattern guards. *)
+
+let nested_multiway f g h = function
+  | Some x when f x match (
+      | "foo" when h x -> "foo1"
+      | "bar" when g x match (
+          | [] -> "bar empty"
+          | [ y ] -> "bar singleton " ^ y
+        )
+    )
+  | _ -> "not found"
+;;
+[%%expect{|
+val nested_multiway :
+  ('a -> string) ->
+  ('a -> string list) -> ('a -> bool) -> 'a option -> string = <fun>
+|}];;
+
+let f = function
+  | 0 | 1 -> "foo"
+  | 10 | 100 | 1000 -> "bar"
+  | _ -> "neither"
+;;
+[%%expect{|
+val f : int -> string = <fun>
+|}];;
+
+let g = function
+  | 10 -> []
+  | 100 -> [ "one" ]
+  | _ -> [ "more"; "than"; "one" ]
+;;
+[%%expect{|
+val g : int -> string list = <fun>
+|}];;
+
+let h x = x = 1;;
+[%%expect{|
+val h : int -> bool = <fun>
+|}];;
+
+nested_multiway f g h None;;
+[%%expect{|
+- : string = "not found"
+|}];;
+nested_multiway f g h (Some 0);;
+[%%expect{|
+- : string = "not found"
+|}];;
+nested_multiway f g h (Some 1);;
+[%%expect{|
+- : string = "foo1"
+|}];;
+nested_multiway f g h (Some 10);;
+[%%expect{|
+- : string = "bar empty"
+|}];;
+nested_multiway f g h (Some 100);;
+[%%expect{|
+- : string = "bar singleton one"
+|}];;
+nested_multiway f g h (Some 1000);;
+[%%expect{|
+- : string = "not found"
+|}];;

ocaml/testsuite/tests/pattern-guards/seq.ml

@@ -0,0 +1,56 @@
+(* TEST
+   * expect *)
+
+(* Demonstrate interaction of sequences [(e1; e2; ..; en)] with pattern
+   guards. *)
+
+(* Demonstrate parsing of sequences in boolean guards. *)
+
+let seq_boolean x ~f ~g ~default =
+  match x with
+    | Some x when f x; g x -> x
+    | _ -> default
+;;
+[%%expect{|
+val seq_boolean :
+  'a option -> f:('a -> 'b) -> g:('a -> bool) -> default:'a -> 'a = <fun>
+|}];;
+
+(* Demonstrate semantics of sequences in pattern guard scrutinees. *)
+
+let seq_pattern x ~f ~g ~default =
+  match x with
+    | Some x when (f x; g x) match Some y -> y
+    | _ -> default
+;;
+[%%expect{|
+val seq_pattern :
+  'a option -> f:('a -> 'b) -> g:('a -> 'c option) -> default:'c -> 'c =
+  <fun>
+|}];;
+
+let counter = ref 0;;
+[%%expect{|
+val counter : int ref = {contents = 0}
+|}];;
+let f () = incr counter;;
+[%%expect{|
+val f : unit -> unit = <fun>
+|}];;
+let g () = if !counter > 1 then Some (!counter - 1) else None;;
+[%%expect{|
+val g : unit -> int option = <fun>
+|}];;
+
+seq_pattern (Some ()) ~f ~g ~default:0;;
+[%%expect{|
+- : int = 0
+|}];;
+seq_pattern (Some ()) ~f ~g ~default:0;;
+[%%expect{|
+- : int = 1
+|}];;
+seq_pattern None ~f ~g ~default:0;;
+[%%expect{|
+- : int = 0
+|}];;

ocaml/testsuite/tests/pattern-guards/seq_bad.compilers.reference

@@ -1,4 +1,4 @@
 File "seq_bad.ml", line 13, characters 25-30:
-13 |   | Some x when f x; g x match Some y -> y 
+13 |   | Some x when f x; g x match Some y -> y
                               ^^^^^
 Error: Syntax error

ocaml/testsuite/tests/pattern-guards/seq_bad.ml

@@ -4,12 +4,13 @@
     ocamlopt_opt_exit_status = "2"
   *** check-ocamlopt.opt-output*)
 
-(* One might innocuously write the below code hoping that it parses as
-   [(f x; g x) match ...]. This test demonstrates that this intentionally results in
-   a type error. *)
+(* Demonstrate that [when e1; e2 match P -> e3] is a parse error.
+   One might believe that it parses as [when (e1; e2) match P -> e3], but this
+   is the wrong precedence. *)
 
 let seq_bad x ~f ~g ~default =
   match x with
-  | Some x when f x; g x match Some y -> y 
+  | Some x when f x; g x match Some y -> y
   | _ -> y
+;;