ocaml/testsuite/tests/typing-gadts/pr9019.ml

237 lines
5.1 KiB
OCaml

(* TEST
* expect
*)
(* #9012 by Thomas Refis *)
type ab = A | B
module M : sig
type mab = A | B
type _ t = AB : ab t | MAB : mab t
val ab : mab t
end = struct
type mab = ab = A | B
type _ t = AB : ab t | MAB : mab t
let ab = AB
end
[%%expect{|
type ab = A | B
module M :
sig type mab = A | B type _ t = AB : ab t | MAB : mab t val ab : mab t end
|}]
open M
let f (type x) (t1 : x t) (t2 : x t) (x : x) =
match t1, t2, x with
| AB, AB, A -> 1
| MAB, _, A -> 2
| _, AB, B -> 3
| _, MAB, B -> 4
[%%expect{|
Lines 4-8, characters 2-18:
4 | ..match t1, t2, x with
5 | | AB, AB, A -> 1
6 | | MAB, _, A -> 2
7 | | _, AB, B -> 3
8 | | _, MAB, B -> 4
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(AB, MAB, A)
val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
|}]
let () = ignore (f M.ab MAB A)
[%%expect{|
Exception: Match_failure ("", 4, 2).
|}]
(* variant *)
type _ ab = A | B
module M : sig
type _ mab
type _ t = AB : unit ab t | MAB : unit mab t
val ab : unit mab t
val a : 'a mab
val b : 'a mab
end = struct
type 'a mab = 'a ab = A | B
type _ t = AB : unit ab t | MAB : unit mab t
let ab = AB
let a = A
let b = B
end;;
[%%expect{|
type _ ab = A | B
module M :
sig
type _ mab
type _ t = AB : unit ab t | MAB : unit mab t
val ab : unit mab t
val a : 'a mab
val b : 'a mab
end
|}]
open M
(* The second clause isn't redundant *)
let f (type x) (t1 : x t) (t2 : x t) (x : x) =
match t1, t2, x with
| AB, AB, A -> 1
| _, AB, A -> 2
| _, AB, B -> 3
| _, MAB, _ -> 4;;
[%%expect{|
val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
|}]
(* the answer shouldn't be 3 *)
let x = f MAB M.ab M.a;;
[%%expect{|
val x : int = 2
|}]
(* using records *)
type ab = { a : int }
module M : sig
type mab = { a : int }
type _ t = AB : ab t | MAB : mab t
val a : mab
val ab : mab t
end = struct
type mab = ab = { a : int }
type _ t = AB : ab t | MAB : mab t
let a = { a = 42 }
let ab = AB
end;;
[%%expect{|
type ab = { a : int; }
module M :
sig
type mab = { a : int; }
type _ t = AB : ab t | MAB : mab t
val a : mab
val ab : mab t
end
|}]
open M
let f (type x) (t1 : x t) (t2 : x t) (x : x) =
match t1, t2, x with
| AB, AB, { a = _ } -> 1
| MAB, _, { a = _ } -> 2
| _, AB, { a = _ } -> 3
| _, MAB, { a = _ } -> 4;;
[%%expect{|
Line 7, characters 4-22:
7 | | _, AB, { a = _ } -> 3
^^^^^^^^^^^^^^^^^^
Warning 11 [redundant-case]: this match case is unused.
val f : 'x M.t -> 'x M.t -> 'x -> int = <fun>
|}]
let p = f M.ab MAB { a = 42 };;
[%%expect{|
val p : int = 4
|}]
(* #9019 by Leo White *)
type _ a_or_b =
A_or_B : [< `A of string | `B of int] a_or_b
type _ a =
| A : [> `A of string] a
| Not_A : _ a
let f (type x) (a : x a) (a_or_b : x a_or_b) (x : x) =
match a, a_or_b, x with
| Not_A, A_or_B, `B i -> print_int i
| _, A_or_B, `A s -> print_string s
[%%expect{|
type _ a_or_b = A_or_B : [< `A of string | `B of int ] a_or_b
type _ a = A : [> `A of string ] a | Not_A : 'a a
Lines 9-11, characters 2-37:
9 | ..match a, a_or_b, x with
10 | | Not_A, A_or_B, `B i -> print_int i
11 | | _, A_or_B, `A s -> print_string s
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(A, A_or_B, `B _)
val f : 'x a -> 'x a_or_b -> 'x -> unit = <fun>
|}]
let segfault = f A A_or_B (`B 0)
[%%expect{|
Exception: Match_failure ("", 9, 2).
|}]
(* Another example *)
type (_, _) b =
| A : ([< `A ], 'a) b
| B : ([< `B of 'a], 'a) b
type _ ty =
| String_option : string option ty
let f (type x) (type y) (b : (x, y ty) b) (x : x) (y : y) =
match b, x, y with
| B, `B String_option, Some s -> print_string s
| A, `A, _ -> ()
[%%expect{|
type (_, _) b = A : ([< `A ], 'a) b | B : ([< `B of 'a ], 'a) b
type _ ty = String_option : string option ty
Lines 9-11, characters 2-18:
9 | ..match b, x, y with
10 | | B, `B String_option, Some s -> print_string s
11 | | A, `A, _ -> ()
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
(B, `B String_option, None)
val f : ('x, 'y ty) b -> 'x -> 'y -> unit = <fun>
|}]
let segfault = f B (`B String_option) None
[%%expect{|
Exception: Match_failure ("", 9, 2).
|}]
(* More polymorphic variants *)
type 'a a = private [< `A of 'a];;
let f (x : _ a) = match x with `A None -> ();;
[%%expect{|
type 'a a = private [< `A of 'a ]
Line 2, characters 18-44:
2 | let f (x : _ a) = match x with `A None -> ();;
^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`A (Some _)
val f : 'a option a -> unit = <fun>
|}]
let f (x : [> `A] a) = match x with `A `B -> ();;
[%%expect{|
Line 1, characters 23-47:
1 | let f (x : [> `A] a) = match x with `A `B -> ();;
^^^^^^^^^^^^^^^^^^^^^^^^
Warning 8 [partial-match]: this pattern-matching is not exhaustive.
Here is an example of a case that is not matched:
`A `A
val f : [< `A | `B > `A ] a -> unit = <fun>
|}]