diff options
67 files changed, 620 insertions, 2 deletions
diff --git a/testsuite/tests/messages/precise_locations.ml b/testsuite/tests/messages/precise_locations.ml index 62c1aefef2..d3f673b960 100644 --- a/testsuite/tests/messages/precise_locations.ml +++ b/testsuite/tests/messages/precise_locations.ml @@ -7,6 +7,8 @@ type t = (unit, unit, unit, unit) bar (* PR#7315: we expect the error location on "bar" instead of "(...) bar" *) [%%expect{| Line _, characters 34-37: + type t = (unit, unit, unit, unit) bar + ^^^ Error: Unbound type constructor bar |}];; @@ -15,6 +17,8 @@ function (x : (* we expect the location on "bar" instead of "#bar" *) [%%expect{| Line _, characters 1-4: + #bar) -> ();; + ^^^ Error: Unbound class bar |}];; @@ -24,6 +28,8 @@ function (* we expect the location on "bar" instead of "#bar" *) [%%expect{| Line _, characters 1-4: + #bar -> () + ^^^ Error: Unbound type constructor bar |}];; @@ -31,6 +37,8 @@ new bar;; (* we expect the location on "bar" instead of "new bar" *) [%%expect{| Line _, characters 4-7: + new bar;; + ^^^ Error: Unbound class bar |}];; @@ -44,6 +52,8 @@ Foo ();; [%%expect{| type t = Foo of unit | Bar Line _, characters 0-6: + Foo ();; + ^^^^^^ Error (warning 3): deprecated: Foo |}];; function @@ -51,6 +61,8 @@ Foo _ -> () | Bar -> ();; (* "Foo _", the whole construct is deprecated *) [%%expect{| Line _, characters 0-5: + Foo _ -> () | Bar -> ();; + ^^^^^ Error (warning 3): deprecated: Foo |}];; @@ -59,6 +71,8 @@ open Foo;; (* the error location should be on "Foo" *) [%%expect{| Line _, characters 5-8: + open Foo;; + ^^^ Error: Unbound module Foo |}];; @@ -70,6 +84,8 @@ end);; on "open List" as whole rather than "List" *) [%%expect{| Line _, characters 0-9: + open List + ^^^^^^^^^ Error (warning 33): unused open List. |}];; @@ -77,6 +93,8 @@ type unknown += Foo;; (* unknown, not the whole line *) [%%expect{| Line _, characters 5-12: + type unknown += Foo;; + ^^^^^^^ Error: Unbound type constructor unknown |}];; @@ -87,5 +105,7 @@ Foo = Foobar;; [%%expect{| type t = .. Line _, characters 6-12: + Foo = Foobar;; + ^^^^^^ Error: Unbound constructor Foobar |}];; diff --git a/testsuite/tests/typing-core-bugs/example_let_missing_rec.ml b/testsuite/tests/typing-core-bugs/example_let_missing_rec.ml index 6d80fe039f..5ee8017ea2 100644 --- a/testsuite/tests/typing-core-bugs/example_let_missing_rec.ml +++ b/testsuite/tests/typing-core-bugs/example_let_missing_rec.ml @@ -7,6 +7,8 @@ let facto n = (* missing [rec] *) [%%expect{| Line _, characters 28-33: + if n = 0 then 1 else n * facto (n-1) + ^^^^^ Error: Unbound value facto. Hint: You are probably missing the `rec' keyword on line 1. |}] diff --git a/testsuite/tests/typing-core-bugs/example_let_missing_rec_loc.ml b/testsuite/tests/typing-core-bugs/example_let_missing_rec_loc.ml index 4f208389b1..47d8bfe5b8 100644 --- a/testsuite/tests/typing-core-bugs/example_let_missing_rec_loc.ml +++ b/testsuite/tests/typing-core-bugs/example_let_missing_rec_loc.ml @@ -7,6 +7,8 @@ let f x = f x in ();; [%%expect{| Line _, characters 10-11: + let f x = f x in + ^ Error: Unbound value f. Hint: You are probably missing the `rec' keyword on line 2. |}];; diff --git a/testsuite/tests/typing-core-bugs/example_let_missing_rec_mutual.ml b/testsuite/tests/typing-core-bugs/example_let_missing_rec_mutual.ml index 84d8c5c801..790e86a886 100644 --- a/testsuite/tests/typing-core-bugs/example_let_missing_rec_mutual.ml +++ b/testsuite/tests/typing-core-bugs/example_let_missing_rec_mutual.ml @@ -8,6 +8,8 @@ and h x = if x < 0 then x else g (x-1) [%%expect{| Line _, characters 31-32: + let f x = if x < 0 then x else h (x-1) + ^ Error: Unbound value h. Hint: You are probably missing the `rec' keyword on line 1. |}] diff --git a/testsuite/tests/typing-core-bugs/unit_fun_hints.ml b/testsuite/tests/typing-core-bugs/unit_fun_hints.ml index 8dab8e710d..1eb1c73add 100644 --- a/testsuite/tests/typing-core-bugs/unit_fun_hints.ml +++ b/testsuite/tests/typing-core-bugs/unit_fun_hints.ml @@ -9,6 +9,8 @@ let _ = g 3;; (* missing `fun () ->' *) [%%expect{| val g : (unit -> 'a) -> 'a = <fun> Line _, characters 10-11: + let _ = g 3;; (* missing `fun () ->' *) + ^ Error: This expression has type int but an expression was expected of type unit -> 'a Hint: Did you forget to wrap the expression using `fun () ->'? @@ -24,6 +26,8 @@ let _ = about print_newline not being of type unit *) [%%expect{| Line _, characters 3-16: + print_newline; (* missing unit argument *) + ^^^^^^^^^^^^^ Error: This expression has type unit -> unit but an expression was expected of type unit Hint: Did you forget to provide `()' as argument? @@ -34,6 +38,8 @@ print_int x;; [%%expect{| Line _, characters 10-11: + print_int x;; + ^ Error: This expression has type unit -> int but an expression was expected of type int Hint: Did you forget to provide `()' as argument? @@ -45,6 +51,8 @@ let g f = [%%expect{| Line _, characters 6-7: + f = 3;; + ^ Error: This expression has type int but an expression was expected of type unit -> 'a Hint: Did you forget to wrap the expression using `fun () ->'? @@ -56,6 +64,8 @@ let g f = [%%expect{| Line _, characters 6-7: + 3 = f;; + ^ Error: This expression has type unit -> 'a but an expression was expected of type int Hint: Did you forget to provide `()' as argument? diff --git a/testsuite/tests/typing-deprecated/deprecated.ml b/testsuite/tests/typing-deprecated/deprecated.ml index bb62242cf6..902483d7e2 100644 --- a/testsuite/tests/typing-deprecated/deprecated.ml +++ b/testsuite/tests/typing-deprecated/deprecated.ml @@ -17,6 +17,8 @@ end = struct end;; [%%expect{| Line _, characters 9-10: + val x: t [@@ocaml.deprecated] + ^ Warning 3: deprecated: t module X : sig type t type s type u val x : t end |}] @@ -25,6 +27,8 @@ type t = X.t ;; [%%expect{| Line _, characters 9-12: + type t = X.t + ^^^ Warning 3: deprecated: X.t type t = X.t |}] @@ -33,6 +37,8 @@ let x = X.x ;; [%%expect{| Line _, characters 8-11: + let x = X.x + ^^^ Warning 3: deprecated: X.x val x : X.t = <abstr> |}] @@ -43,8 +49,12 @@ type t = X.t * X.s ;; [%%expect{| Line _, characters 9-12: + type t = X.t * X.s + ^^^ Warning 3: deprecated: X.t Line _, characters 15-18: + type t = X.t * X.s + ^^^ Warning 3: deprecated: X.s type t = X.t * X.s |}] @@ -60,6 +70,8 @@ and t2 = X.s ;; [%%expect{| Line _, characters 9-12: + and t2 = X.s + ^^^ Warning 3: deprecated: X.s type t1 = X.t and t2 = X.s @@ -69,6 +81,8 @@ type t = A of t [@@ocaml.deprecated] ;; [%%expect{| Line _, characters 14-15: + type t = A of t [@@ocaml.deprecated] + ^ Warning 3: deprecated: t type t = A of t |}] @@ -93,6 +107,8 @@ type t = (X.t [@ocaml.warning "-3"]) * X.s ;; [%%expect{| Line _, characters 39-42: + type t = (X.t [@ocaml.warning "-3"]) * X.s + ^^^ Warning 3: deprecated: X.s type t = X.t * X.s |}] @@ -111,6 +127,8 @@ let _ = function (_ : X.t) -> () ;; [%%expect{| Line _, characters 22-25: + let _ = function (_ : X.t) -> () + ^^^ Warning 3: deprecated: X.t - : X.t -> unit = <fun> |}] @@ -128,6 +146,8 @@ module M = struct let x = X.x end ;; [%%expect{| Line _, characters 26-29: + module M = struct let x = X.x end + ^^^ Warning 3: deprecated: X.x module M : sig val x : X.t end |}] @@ -148,8 +168,12 @@ module M : sig val x : X.t end module rec M : sig val x: X.t end = struct let x = X.x end [%%expect{| Line _, characters 26-29: + module rec M : sig val x: X.t end = struct let x = X.x end + ^^^ Warning 3: deprecated: X.t Line _, characters 51-54: + module rec M : sig val x: X.t end = struct let x = X.x end + ^^^ Warning 3: deprecated: X.x module rec M : sig val x : X.t end |}] @@ -171,6 +195,8 @@ module rec M : struct let x = X.x end [%%expect{| Line _, characters 17-20: + struct let x = X.x end + ^^^ Warning 3: deprecated: X.x module rec M : sig val x : X.t end |}] @@ -181,6 +207,8 @@ module type S = sig type t = X.t end ;; [%%expect{| Line _, characters 29-32: + module type S = sig type t = X.t end + ^^^ Warning 3: deprecated: X.t module type S = sig type t = X.t end |}] @@ -204,6 +232,8 @@ class c = object method x = X.x end ;; [%%expect{| Line _, characters 28-31: + class c = object method x = X.x end + ^^^ Warning 3: deprecated: X.x class c : object method x : X.t end |}] @@ -233,6 +263,8 @@ class type c = object method x : X.t end ;; [%%expect{| Line _, characters 33-36: + class type c = object method x : X.t end + ^^^ Warning 3: deprecated: X.t class type c = object method x : X.t end |}] @@ -263,6 +295,8 @@ external foo: unit -> X.t = "foo" ;; [%%expect{| Line _, characters 22-25: + external foo: unit -> X.t = "foo" + ^^^ Warning 3: deprecated: X.t external foo : unit -> X.t = "foo" |}] @@ -280,6 +314,8 @@ X.x ;; [%%expect{| Line _, characters 0-3: + X.x + ^^^ Warning 3: deprecated: X.x - : X.t = <abstr> |}] @@ -300,6 +336,8 @@ open D [%%expect{| module D : sig end Line _, characters 5-6: + open D + ^ Warning 3: deprecated: module D |}] @@ -312,6 +350,8 @@ include D ;; [%%expect{| Line _, characters 8-9: + include D + ^ Warning 3: deprecated: module D |}] @@ -336,6 +376,8 @@ type ext += ;; [%%expect{| Line _, characters 9-12: + | A of X.t + ^^^ Warning 3: deprecated: X.t type ext += A of X.t | B of X.s | C of X.u |}] @@ -353,6 +395,8 @@ exception Foo of X.t ;; [%%expect{| Line _, characters 17-20: + exception Foo of X.t + ^^^ Warning 3: deprecated: X.t exception Foo of X.t |}] @@ -373,6 +417,8 @@ type t = ;; [%%expect{| Line _, characters 9-12: + | A of X.t + ^^^ Warning 3: deprecated: X.t type t = A of X.t | B of X.s | C of X.u |}] @@ -386,6 +432,8 @@ type t = ;; [%%expect{| Line _, characters 7-10: + a: X.t; + ^^^ Warning 3: deprecated: X.t type t = { a : X.t; b : X.s; c : X.u; } |}] @@ -400,6 +448,8 @@ type t = ;; [%%expect{| Line _, characters 7-10: + a: X.t; + ^^^ Warning 3: deprecated: X.t type t = < a : X.t; b : X.s; c : X.u > |}] @@ -414,6 +464,8 @@ type t = ;; [%%expect{| Line _, characters 10-13: + | `A of X.t + ^^^ Warning 3: deprecated: X.t type t = [ `A of X.t | `B of X.s | `C of X.u ] |}] @@ -426,6 +478,8 @@ type t = [ `A of X.t | `B of X.s | `C of X.u ] ;; [%%expect{| Line _, characters 20-33: + [@@@ocaml.ppwarning "Pp warning!"] + ^^^^^^^^^^^^^ Warning 22: Pp warning! |}] @@ -435,8 +489,12 @@ let x = () [@ocaml.ppwarning "Pp warning 1!"] ;; [%%expect{| Line _, characters 24-39: + [@@ocaml.ppwarning "Pp warning 2!"] + ^^^^^^^^^^^^^^^ Warning 22: Pp warning 2! Line _, characters 29-44: + let x = () [@ocaml.ppwarning "Pp warning 1!"] + ^^^^^^^^^^^^^^^ Warning 22: Pp warning 1! val x : unit = () |}] @@ -446,6 +504,8 @@ type t = unit ;; [%%expect{| Line _, characters 22-35: + [@ocaml.ppwarning "Pp warning!"] + ^^^^^^^^^^^^^ Warning 22: Pp warning! type t = unit |}] @@ -462,6 +522,8 @@ end ;; [%%expect{| Line _, characters 22-36: + [@@@ocaml.ppwarning "Pp warning2!"] + ^^^^^^^^^^^^^^ Warning 22: Pp warning2! module X : sig end |}] @@ -470,6 +532,8 @@ let x = ((() [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocam ;; [%%expect{| Line _, characters 93-108: + let x = ((() [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocaml.ppwarning "Pp warning 2!"] + ^^^^^^^^^^^^^^^ Warning 22: Pp warning 2! val x : unit = () |}] @@ -479,8 +543,12 @@ type t = ((unit [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@o ;; [%%expect{| Line _, characters 21-36: + [@@ocaml.ppwarning "Pp warning 3!"] + ^^^^^^^^^^^^^^^ Warning 22: Pp warning 3! Line _, characters 96-111: + type t = ((unit [@ocaml.ppwarning "Pp warning 1!"]) [@ocaml.warning "-22"]) [@ocaml.ppwarning "Pp warning 2!"] + ^^^^^^^^^^^^^^^ Warning 22: Pp warning 2! type t = unit |}] @@ -489,8 +557,12 @@ let ([][@ocaml.ppwarning "XX"]) = [] ;; [%%expect{| Line _, characters 25-29: + let ([][@ocaml.ppwarning "XX"]) = [] + ^^^^ Warning 22: XX Line _, characters 4-31: + let ([][@ocaml.ppwarning "XX"]) = [] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: _::_ diff --git a/testsuite/tests/typing-gadts/didier.ml b/testsuite/tests/typing-gadts/didier.ml index d23e919264..749ae6672c 100644 --- a/testsuite/tests/typing-gadts/didier.ml +++ b/testsuite/tests/typing-gadts/didier.ml @@ -13,6 +13,8 @@ let fbool (type t) (x : t) (tag : t ty) = [%%expect{| type 'a ty = Int : int ty | Bool : bool ty Line _, characters 2-30: + ..match tag with + | Bool -> x Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Int @@ -27,6 +29,8 @@ let fint (type t) (x : t) (tag : t ty) = ;; [%%expect{| Line _, characters 2-33: + ..match tag with + | Int -> x > 0 Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Bool @@ -46,6 +50,8 @@ let f (type t) (x : t) (tag : t ty) = val f : 'a -> 'a ty -> bool = <fun> |}, Principal{| Line _, characters 12-13: + | Bool -> x + ^ Error: This expression has type t but an expression was expected of type bool |}];; (* val f : 'a -> 'a ty -> bool = <fun> *) @@ -58,10 +64,14 @@ let g (type t) (x : t) (tag : t ty) = ;; [%%expect{| Line _, characters 11-16: + | Int -> x > 0 + ^^^^^ Error: This expression has type bool but an expression was expected of type t = int |}, Principal{| Line _, characters 11-16: + | Int -> x > 0 + ^^^^^ Error: This expression has type bool but an expression was expected of type t |}];; (* Error: This expression has type bool but an expression was expected of type diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml b/testsuite/tests/typing-gadts/dynamic_frisch.ml index a97dcef607..7af47672b2 100644 --- a/testsuite/tests/typing-gadts/dynamic_frisch.ml +++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml @@ -602,6 +602,8 @@ let ty_list : type a e. (a,e) ty -> (a vlist,e) ty = fun t -> ;; [%%expect{| Line _, characters 41-58: + | "Cons", Some (Tdyn (Pair (_, Var), (p : a * a vlist))) -> `Cons p))) + ^^^^^^^^^^^^^^^^^ Error: This pattern matches values of type a * a vlist but a pattern was expected which matches values of type $Tdyn_'a = $0 * $1 diff --git a/testsuite/tests/typing-gadts/nested_equations.ml b/testsuite/tests/typing-gadts/nested_equations.ml index 2b0ef127d4..ffb7084ca4 100644 --- a/testsuite/tests/typing-gadts/nested_equations.ml +++ b/testsuite/tests/typing-gadts/nested_equations.ml @@ -17,6 +17,8 @@ let f_bool (x : bool) : int = let Int = w_bool in x;; (* fail *) [%%expect{| val w_bool : bool t = Int Line _, characters 34-37: + let f_bool (x : bool) : int = let Int = w_bool in x;; (* fail *) + ^^^ Error: This pattern matches values of type int t but a pattern was expected which matches values of type bool t Type int is not compatible with type bool @@ -34,6 +36,8 @@ let f_spec (x : Arg.spec) : int = let Int = w_spec in x;; (* fail *) [%%expect{| val w_spec : Arg.spec t = Int Line _, characters 38-41: + let f_spec (x : Arg.spec) : int = let Int = w_spec in x;; (* fail *) + ^^^ Error: This pattern matches values of type int t but a pattern was expected which matches values of type Arg.spec t Type int is not compatible with type Arg.spec diff --git a/testsuite/tests/typing-gadts/pr5332.ml b/testsuite/tests/typing-gadts/pr5332.ml index f88a7b6c1a..9747cb9b01 100644 --- a/testsuite/tests/typing-gadts/pr5332.ml +++ b/testsuite/tests/typing-gadts/pr5332.ml @@ -27,6 +27,8 @@ type ('env, 'a) typ = | Tbool : ('env, bool) typ | Tvar : ('env, 'a) var -> ('env, 'a) typ Line _, characters 5-6: + | _ -> . (* error *) + ^ Error: This match case could not be refuted. Here is an example of a value that would reach it: (Tint, Tvar Zero) |}];; diff --git a/testsuite/tests/typing-gadts/pr5689.ml b/testsuite/tests/typing-gadts/pr5689.ml index 67ff08fc88..49375c0f41 100644 --- a/testsuite/tests/typing-gadts/pr5689.ml +++ b/testsuite/tests/typing-gadts/pr5689.ml @@ -101,6 +101,8 @@ let rec process : type a. a linkp2 -> ast_t -> a inline_t = [%%expect{| type _ linkp2 = Kind : 'a linkp -> ([< inkind ] as 'a) linkp2 Line _, characters 35-43: + | (Kind _, Ast_Text txt) -> Text txt + ^^^^^^^^ Error: This expression has type ([< inkind > `Nonlink ] as 'a) inline_t but an expression was expected of type a inline_t Type 'a = [< `Link | `Nonlink > `Nonlink ] is not compatible with type diff --git a/testsuite/tests/typing-gadts/pr5785.ml b/testsuite/tests/typing-gadts/pr5785.ml index 08103f5340..671f88cce0 100644 --- a/testsuite/tests/typing-gadts/pr5785.ml +++ b/testsuite/tests/typing-gadts/pr5785.ml @@ -14,6 +14,9 @@ struct end;; [%%expect{| Line _, characters 43-100: + ...........................................function + | One, One -> "two" + | Two, Two -> "four" Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (Two, One) diff --git a/testsuite/tests/typing-gadts/pr5848.ml b/testsuite/tests/typing-gadts/pr5848.ml index bbf8603c09..c0332bb894 100644 --- a/testsuite/tests/typing-gadts/pr5848.ml +++ b/testsuite/tests/typing-gadts/pr5848.ml @@ -20,5 +20,7 @@ let of_type: type a. a -> a = fun x -> module B : sig type (_, _) t = Eq : ('a, 'a) t val f : 'a -> 'b -> ('a, 'b) t end Line _, characters 4-6: + | Eq -> 5 + ^^ Error: The GADT constructor Eq of type B.t must be qualified in this pattern. |}];; diff --git a/testsuite/tests/typing-gadts/pr5906.ml b/testsuite/tests/typing-gadts/pr5906.ml index 3ae126c5ac..b3c1982784 100644 --- a/testsuite/tests/typing-gadts/pr5906.ml +++ b/testsuite/tests/typing-gadts/pr5906.ml @@ -28,6 +28,11 @@ type (_, _, _) binop = | Leq : ('a, 'a, bool) binop | Add : (int, int, int) binop Line _, characters 2-195: + ..match bop, x, y with + | Eq, Bool x, Bool y -> Bool (if x then y else not y) + | Leq, Int x, Int y -> Bool (x <= y) + | Leq, Bool x, Bool y -> Bool (x <= y) + | Add, Int x, Int y -> Int (x + y) Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (Eq, Int _, _) diff --git a/testsuite/tests/typing-gadts/pr5948.ml b/testsuite/tests/typing-gadts/pr5948.ml index 48ce2e55a6..59852564f5 100644 --- a/testsuite/tests/typing-gadts/pr5948.ml +++ b/testsuite/tests/typing-gadts/pr5948.ml @@ -40,6 +40,8 @@ val intAorB : [< `TagA of int | `TagB ] -> int = <fun> type _ wrapPoly = WrapPoly : 'a poly -> ([< `TagA of int | `TagB ] as 'a) wrapPoly Line _, characters 23-27: + | WrapPoly ATag -> intA + ^^^^ Error: This expression has type ([< `TagA of 'b ] as 'a) -> 'b but an expression was expected of type a -> int Type [< `TagA of 'b ] as 'a is not compatible with type @@ -51,5 +53,7 @@ let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) ;; [%%expect{| Line _, characters 9-17: + let _ = example6 (WrapPoly AandBTags) `TagB (* This causes a seg fault *) + ^^^^^^^^ Error: Unbound value example6 |}];; diff --git a/testsuite/tests/typing-gadts/pr5981.ml b/testsuite/tests/typing-gadts/pr5981.ml index 8dfdaa3b7e..4d6d69e96a 100644 --- a/testsuite/tests/typing-gadts/pr5981.ml +++ b/testsuite/tests/typing-gadts/pr5981.ml @@ -13,6 +13,8 @@ module F(S : sig type 'a t end) = struct end;; [%%expect{| Line _, characters 47-84: + ...............................................match l, r with + | A, B -> "f A B" Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (A, A) @@ -38,6 +40,8 @@ module F(S : sig type 'a t end) = struct end;; [%%expect{| Line _, characters 15-52: + ...............match l, r with + | A, B -> "f A B" Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (A, A) diff --git a/testsuite/tests/typing-gadts/pr5985.ml b/testsuite/tests/typing-gadts/pr5985.ml index 5c8dadf745..06c5125b49 100644 --- a/testsuite/tests/typing-gadts/pr5985.ml +++ b/testsuite/tests/typing-gadts/pr5985.ml @@ -9,6 +9,8 @@ module F (S : sig type 'a s end) = struct end;; (* fail *) [%%expect{| Line _, characters 2-29: + type _ t = T : 'a -> 'a s t + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; @@ -36,6 +38,8 @@ module F(T:sig type 'a t end) = struct end;; (* fail *) [%%expect{| Line _, characters 2-86: + ..class ['a] c x = + object constraint 'a = 'b T.t val x' : 'b = x method x = x' end Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; @@ -48,6 +52,8 @@ let magic (x : int) : bool = x;; (* fail *) [%%expect{| Line _, characters 0-49: + type 'x t = A of 'a constraint 'x = [< `X of 'a ] ;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; @@ -55,6 +61,8 @@ Error: In this definition, a type variable cannot be deduced type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *) [%%expect{| Line _, characters 0-37: + type 'a t = A : 'a -> [< `X of 'a ] t;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; @@ -70,6 +78,8 @@ type (_, _) eq = Eq : ('a, 'a) eq val eq : 'a = <poly> val eq : ('a Queue.t, 'b Queue.t) eq = Eq Line _, characters 0-33: + type _ t = T : 'a -> 'a Queue.t t;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; @@ -86,6 +96,8 @@ module type S = sig end;; (* fail *) [%%expect{| Line _, characters 2-29: + type _ t = T : 'a -> 'a s t + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; @@ -93,6 +105,8 @@ Error: In this definition, a type variable cannot be deduced module rec M : (S with type 'a s = unit) = M;; [%%expect{| Line _, characters 16-17: + module rec M : (S with type 'a s = unit) = M;; + ^ Error: Unbound module type S |}];; (* For the above reason, we cannot allow the abstract declaration @@ -116,6 +130,8 @@ type +'a t = 'b constraint 'a = 'b q;; [%%expect{| type 'a q = Q Line _, characters 0-36: + type +'a t = 'b constraint 'a = 'b q;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable has a variance that cannot be deduced from the type parameters. It was expected to be unrestricted, but it is covariant. @@ -131,6 +147,8 @@ type +'a s = 'b constraint 'a = 'b t type -'a s = 'b constraint 'a = 'b t;; (* fail *) [%%expect{| Line _, characters 0-36: + type -'a s = 'b constraint 'a = 'b t;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable has a variance that is not reflected by its occurrence in type parameters. It was expected to be contravariant, but it is covariant. @@ -150,6 +168,8 @@ type +'a s = 'b constraint 'a = 'b q t type +'a s = 'b constraint 'a = 'b t q;; (* fail *) [%%expect{| Line _, characters 0-38: + type +'a s = 'b constraint 'a = 'b t q;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable has a variance that cannot be deduced from the type parameters. It was expected to be unrestricted, but it is covariant. @@ -176,6 +196,8 @@ type _ g = G : 'a -> 'a t g;; (* fail *) [%%expect{| type +'a t = unit constraint 'a = 'b list Line _, characters 0-27: + type _ g = G : 'a -> 'a t g;; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this definition, a type variable cannot be deduced from the type parameters. |}];; diff --git a/testsuite/tests/typing-gadts/pr5989.ml b/testsuite/tests/typing-gadts/pr5989.ml index 5712430907..3b51c9cd13 100644 --- a/testsuite/tests/typing-gadts/pr5989.ml +++ b/testsuite/tests/typing-gadts/pr5989.ml @@ -26,6 +26,8 @@ let () = print_endline (f M.eq) ;; type (_, _) t = Any : ('a, 'b) t | Eq : ('a, 'a) t module M : sig type s = private [> `A ] val eq : (s, [ `A | `B ]) t end Line _, characters 39-64: + .......................................function + | Any -> "Any" Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Eq @@ -54,6 +56,8 @@ module N : val eq : (s, < a : int; b : bool >) t end Line _, characters 49-74: + .................................................function + | Any -> "Any" Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Eq diff --git a/testsuite/tests/typing-gadts/pr5997.ml b/testsuite/tests/typing-gadts/pr5997.ml index 82c8c387cb..f9ca2cf818 100644 --- a/testsuite/tests/typing-gadts/pr5997.ml +++ b/testsuite/tests/typing-gadts/pr5997.ml @@ -23,6 +23,8 @@ type (_, _) comp = Eq : ('a, 'a) comp | Diff : ('a, 'b) comp module U : sig type t = T end module M : sig type t = T val comp : (U.t, t) comp end Line _, characters 0-33: + match M.comp with | Diff -> false;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Eq @@ -44,6 +46,8 @@ match M.comp with | Diff -> false;; module U : sig type t = { x : int; } end module M : sig type t = { x : int; } val comp : (U.t, t) comp end Line _, characters 0-33: + match M.comp with | Diff -> false;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Eq diff --git a/testsuite/tests/typing-gadts/pr6158.ml b/testsuite/tests/typing-gadts/pr6158.ml index 1074a66f00..c52fa026d6 100644 --- a/testsuite/tests/typing-gadts/pr6158.ml +++ b/testsuite/tests/typing-gadts/pr6158.ml @@ -16,6 +16,8 @@ type 'a t = T of 'a type 'a s = S of 'a type (_, _) eq = Refl : ('a, 'a) eq Line _, characters 45-49: + let f : (int s, int t) eq -> unit = function Refl -> ();; + ^^^^ Error: This pattern matches values of type (int s, int s) eq but a pattern was expected which matches values of type (int s, int t) eq diff --git a/testsuite/tests/typing-gadts/pr6163.ml b/testsuite/tests/typing-gadts/pr6163.ml index 4411401f8b..38642f3224 100644 --- a/testsuite/tests/typing-gadts/pr6163.ml +++ b/testsuite/tests/typing-gadts/pr6163.ml @@ -25,6 +25,8 @@ type aux = [ `Succ of [< [< [< [ `Zero ] pre_nat ] pre_nat ] pre_nat ] ] nat -> aux Line _, characters 4-5: + | _ -> . (* error *) + ^ Error: This match case could not be refuted. Here is an example of a value that would reach it: Succ (Succ (Succ (Succ (Succ Zero)))) diff --git a/testsuite/tests/typing-gadts/pr6174.ml b/testsuite/tests/typing-gadts/pr6174.ml index 20d807a5ff..fbf799a65a 100644 --- a/testsuite/tests/typing-gadts/pr6174.ml +++ b/testsuite/tests/typing-gadts/pr6174.ml @@ -8,6 +8,8 @@ let f : type a o. ((a -> o) -> o) t -> (a -> o) -> o = [%%expect{| type _ t = C : ((('a -> 'o) -> 'o) -> ('b -> 'o) -> 'o) t Line _, characters 24-25: + fun C k -> k (fun x -> x);; + ^ Error: This expression has type $0 but an expression was expected of type $1 = ($2 -> $1) -> $1 |}];; diff --git a/testsuite/tests/typing-gadts/pr6241.ml b/testsuite/tests/typing-gadts/pr6241.ml index 1aa569bed8..77f0bdff1f 100644 --- a/testsuite/tests/typing-gadts/pr6241.ml +++ b/testsuite/tests/typing-gadts/pr6241.ml @@ -22,6 +22,8 @@ let x = N.f A;; [%%expect{| type (_, _) t = A : ('a, 'a) t | B : string -> ('a, 'b) t Line _, characters 52-74: + ....................................................function + | B s -> s Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: A diff --git a/testsuite/tests/typing-gadts/pr6690.ml b/testsuite/tests/typing-gadts/pr6690.ml index 29202c3676..bfe6a353ae 100644 --- a/testsuite/tests/typing-gadts/pr6690.ml +++ b/testsuite/tests/typing-gadts/pr6690.ml @@ -27,6 +27,8 @@ type ('a, 'result, 'visit_action) context = Local : ('a, 'a * insert, 'a local_visit_action) context | Global : ('a, 'a, 'a visit_action) context Line _, characters 4-9: + | Local -> fun _ -> raise Exit + ^^^^^ Error: This pattern matches values of type ($0, $0 * insert, $0 local_visit_action) context but a pattern was expected which matches values of type @@ -40,6 +42,8 @@ type ('a, 'result, 'visit_action) context = Local : ('a, 'a * insert, 'a local_visit_action) context | Global : ('a, 'a, 'a visit_action) context Line _, characters 4-10: + | Global -> fun _ -> raise Exit + ^^^^^^ Error: This pattern matches values of type ($1, $1, visit_action) context but a pattern was expected which matches values of type ($0, $0 * insert, visit_action) context @@ -54,6 +58,8 @@ let vexpr (type visit_action) ;; [%%expect{| Line _, characters 4-9: + | Local -> fun _ -> raise Exit + ^^^^^ Error: This pattern matches values of type ($'a, $'a * insert, $'a local_visit_action) context but a pattern was expected which matches values of type @@ -61,6 +67,8 @@ Error: This pattern matches values of type The type constructor $'a would escape its scope |}, Principal{| Line _, characters 4-10: + | Global -> fun _ -> raise Exit + ^^^^^^ Error: This pattern matches values of type ($1, $1, visit_action) context but a pattern was expected which matches values of type ($0, $0 * insert, visit_action) context diff --git a/testsuite/tests/typing-gadts/pr6934.ml b/testsuite/tests/typing-gadts/pr6934.ml index b871fcb12e..789a0ebcb8 100644 --- a/testsuite/tests/typing-gadts/pr6934.ml +++ b/testsuite/tests/typing-gadts/pr6934.ml @@ -5,6 +5,8 @@ type nonrec t = A : t;; [%%expect{| Line _, characters 16-21: + type nonrec t = A : t;; + ^^^^^ Error: GADT case syntax cannot be used in a 'nonrec' block. |}] diff --git a/testsuite/tests/typing-gadts/pr6980.ml b/testsuite/tests/typing-gadts/pr6980.ml index 3f20051b80..b2321edf66 100644 --- a/testsuite/tests/typing-gadts/pr6980.ml +++ b/testsuite/tests/typing-gadts/pr6980.ml @@ -22,6 +22,8 @@ and 'a second = Second : [< `Bar | `Baz | `Foo > `Bar ] s second type aux = Aux : ([< `Bar | `Foo ] as 'a) t second * ('a -> int) -> aux val it : [< `Bar | `Foo > `Bar ] = `Bar Line _, characters 27-29: + let g (Aux(Second, f)) = f it;; + ^^ Error: This expression has type [< `Bar | `Foo > `Bar ] but an expression was expected of type [< `Bar | `Foo ] Types for tag `Bar are incompatible diff --git a/testsuite/tests/typing-gadts/pr6993_bad.ml b/testsuite/tests/typing-gadts/pr6993_bad.ml index 63fa095e93..d480ee89e4 100644 --- a/testsuite/tests/typing-gadts/pr6993_bad.ml +++ b/testsuite/tests/typing-gadts/pr6993_bad.ml @@ -18,6 +18,8 @@ f B.eq;; [%%expect{| type (_, _) eqp = Y : ('a, 'a) eqp | N : string -> ('a, 'b) eqp Line _, characters 36-66: + let f : ('a list, 'a) eqp -> unit = function N s -> print_string s;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Y diff --git a/testsuite/tests/typing-gadts/pr7016.ml b/testsuite/tests/typing-gadts/pr7016.ml index 9cacf27f60..cb618cc748 100644 --- a/testsuite/tests/typing-gadts/pr7016.ml +++ b/testsuite/tests/typing-gadts/pr7016.ml @@ -12,6 +12,8 @@ type (_, _) t = Nil : ('tl, 'tl) t | Cons : 'a * ('b, 'tl) t -> ('a * 'b, 'tl) t Line _, characters 9-43: + let get1 (Cons (x, _) : (_ * 'a, 'a) t) = x ;; (* warn, cf PR#6993 *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Nil @@ -25,6 +27,8 @@ let get1' = function val get1' : ('b * 'a as 'a, 'a) t -> 'b = <fun> |}, Principal{| Line _, characters 4-7: + | Nil -> assert false ;; (* ok *) + ^^^ Error: This pattern matches values of type ('b * 'a, 'b * 'a) t but a pattern was expected which matches values of type ('b * 'a, 'a) t diff --git a/testsuite/tests/typing-gadts/pr7160.ml b/testsuite/tests/typing-gadts/pr7160.ml index 5efaf9a3fb..1c7633bade 100644 --- a/testsuite/tests/typing-gadts/pr7160.ml +++ b/testsuite/tests/typing-gadts/pr7160.ml @@ -15,6 +15,8 @@ type _ t = | Same : 'l t -> 'l t val f : int t -> int = <fun> Line _, characters 0-97: + type 'a tt = 'a t = + Int : int -> int tt | String : string -> string tt | Same : 'l1 t -> 'l2 tt.. Error: This variant or record definition does not match that of type 'a t The types for field Same are not equal. |}];; diff --git a/testsuite/tests/typing-gadts/pr7214.ml b/testsuite/tests/typing-gadts/pr7214.ml index 884381c98e..8a589ee858 100644 --- a/testsuite/tests/typing-gadts/pr7214.ml +++ b/testsuite/tests/typing-gadts/pr7214.ml @@ -13,6 +13,8 @@ let f (type a) (x : a t) = [%%expect{| type _ t = I : int t Line _, characters 9-10: + let (I : a t) = x (* fail because of toplevel let *) + ^ Error: This pattern matches values of type int t but a pattern was expected which matches values of type a t Type int is not compatible with type a @@ -35,6 +37,8 @@ let bad (type a) = [%%expect{| type (_, _) eq = Refl : ('a, 'a) eq Line _, characters 10-14: + let (Refl : (int, a) eq) = M.e (* must fail for soundness *) + ^^^^ Error: This pattern matches values of type (int, int) eq but a pattern was expected which matches values of type (int, a) eq Type int is not compatible with type a diff --git a/testsuite/tests/typing-gadts/pr7222.ml b/testsuite/tests/typing-gadts/pr7222.ml index a2258eaea4..290f4448a5 100644 --- a/testsuite/tests/typing-gadts/pr7222.ml +++ b/testsuite/tests/typing-gadts/pr7222.ml @@ -21,6 +21,8 @@ type (_, _) elt = | Elt : 'nat n -> ('l, 'nat -> 'l) elt type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t Line _, characters 11-18: + let Cons(Elt dim, _) = sh in () + ^^^^^^^ Error: This pattern matches values of type ($Cons_'x, 'a -> $Cons_'x) elt but a pattern was expected which matches values of type ($Cons_'x, 'a -> $'b -> nil) elt @@ -33,6 +35,8 @@ type (_, _) elt = | Elt : 'nat n -> ('l, 'nat -> 'l) elt type _ t = Nil : nil t | Cons : ('x, 'fx) elt * 'x t -> 'fx t Line _, characters 6-22: + let Cons(Elt dim, _) = sh in () + ^^^^^^^^^^^^^^^^ Error: This pattern matches values of type ('a -> $0 -> nil) t but a pattern was expected which matches values of type ('a -> 'b -> nil) t diff --git a/testsuite/tests/typing-gadts/pr7234.ml b/testsuite/tests/typing-gadts/pr7234.ml index 81f6b6424d..49c040ed38 100644 --- a/testsuite/tests/typing-gadts/pr7234.ml +++ b/testsuite/tests/typing-gadts/pr7234.ml @@ -9,6 +9,8 @@ let f (type a) (Neq n : (a, a t) eq) = n;; (* warn! *) type (_, _) eq = Eq : ('a, 'a) eq | Neq : int -> ('a, 'b) eq type 'a t Line _, characters 15-40: + let f (type a) (Neq n : (a, a t) eq) = n;; (* warn! *) + ^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Eq @@ -20,6 +22,8 @@ module F (T : sig type _ t end) = struct end;; [%%expect{| Line _, characters 16-43: + let f (type a) (Neq n : (a, a T.t) eq) = n (* warn! *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Eq diff --git a/testsuite/tests/typing-gadts/pr7260.ml b/testsuite/tests/typing-gadts/pr7260.ml index 1b48789035..d5a1567365 100644 --- a/testsuite/tests/typing-gadts/pr7260.ml +++ b/testsuite/tests/typing-gadts/pr7260.ml @@ -20,6 +20,12 @@ type bar = < bar : unit > type _ ty = Int : int ty type dyn = Dyn : 'a ty -> dyn Line _, characters 0-108: + class foo = + object (this) + method foo (Dyn ty) = + match ty with + | Int -> (this :> bar) + end................................. Error: This class should be virtual. The following methods are undefined : bar |}];; diff --git a/testsuite/tests/typing-gadts/pr7269.ml b/testsuite/tests/typing-gadts/pr7269.ml index da2456e4a6..2a07e8b575 100644 --- a/testsuite/tests/typing-gadts/pr7269.ml +++ b/testsuite/tests/typing-gadts/pr7269.ml @@ -12,6 +12,8 @@ type s = [ `A | `B ] and sub = [ `B ] type +'a t = T : [< `Conj of 'a & sub | `Other of string ] -> 'a t Line _, characters 6-47: + let f (T (`Other msg) : s t) = print_string msg;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: T (`Conj _) @@ -38,6 +40,8 @@ module M : val x : t end Line _, characters 12-59: + let () = M.(match x with T (`Other msg) -> print_string msg);; (* warn *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: T (`Conj _) @@ -68,6 +72,8 @@ module M : val e : elim -> unit end Line _, characters 21-57: + let () = M.(e { ex = fun (`Other msg) -> print_string msg });; (* warn *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: `Conj _ diff --git a/testsuite/tests/typing-gadts/pr7374.ml b/testsuite/tests/typing-gadts/pr7374.ml index 1987cae3c7..f682807b6e 100644 --- a/testsuite/tests/typing-gadts/pr7374.ml +++ b/testsuite/tests/typing-gadts/pr7374.ml @@ -22,6 +22,8 @@ end = struct end;; (* should fail *) [%%expect{| Line _, characters 16-20: + fun Refl -> Refl + ^^^^ Error: This expression has type (a, a) eq but an expression was expected of type (a, t) eq Type a is not compatible with type t = [ `Rec of 'a ] X.t as 'a @@ -46,6 +48,8 @@ module F (X : sig type 'a t end) = struct end;; (* should fail *) [%%expect{| Line _, characters 21-25: + fun Refl Refl -> Refl;; + ^^^^ Error: This expression has type (a, a) eq but an expression was expected of type (a, a X.t X.t) eq Type a = b X.t is not compatible with type a X.t X.t diff --git a/testsuite/tests/typing-gadts/pr7378.ml b/testsuite/tests/typing-gadts/pr7378.ml index d84b6cff62..190fbfdc7b 100644 --- a/testsuite/tests/typing-gadts/pr7378.ml +++ b/testsuite/tests/typing-gadts/pr7378.ml @@ -16,6 +16,8 @@ module Y = struct end;; (* should fail *) [%%expect{| Line _, characters 2-54: + ..type t = X.t = + | A : 'a * 'b * ('b -> unit) -> t Error: This variant or record definition does not match that of type X.t The types for field A are not equal. |}] diff --git a/testsuite/tests/typing-gadts/pr7390.ml b/testsuite/tests/typing-gadts/pr7390.ml index 4814c44804..29e23ae7e5 100644 --- a/testsuite/tests/typing-gadts/pr7390.ml +++ b/testsuite/tests/typing-gadts/pr7390.ml @@ -22,6 +22,8 @@ let f (* : filled either -> string *) = fun (Either (Y a, N)) -> a;; [%%expect{| Line _, characters 2-28: + fun (Either (Y a, N)) -> a;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Either (N, Y _) diff --git a/testsuite/tests/typing-gadts/pr7391.ml b/testsuite/tests/typing-gadts/pr7391.ml index ce756459ef..11bc04c7b4 100644 --- a/testsuite/tests/typing-gadts/pr7391.ml +++ b/testsuite/tests/typing-gadts/pr7391.ml @@ -74,6 +74,8 @@ let _ = end;; [%%expect{| Line _, characters 16-22: + inherit child2 + ^^^^^^ Error: The method parent has type < child : 'a; previous : 'b option > but is expected to have type < previous : < .. > option; .. > Self type cannot escape its class diff --git a/testsuite/tests/typing-gadts/pr7421.ml b/testsuite/tests/typing-gadts/pr7421.ml index c73358e6a1..a17a774eeb 100644 --- a/testsuite/tests/typing-gadts/pr7421.ml +++ b/testsuite/tests/typing-gadts/pr7421.ml @@ -14,6 +14,8 @@ let f (x : ('a, empty Lazy.t) result) = | Error (lazy _) -> .;; [%%expect{| Line _, characters 4-18: + | Error (lazy _) -> .;; + ^^^^^^^^^^^^^^ Error: This match case could not be refuted. Here is an example of a value that would reach it: Error lazy _ |}] @@ -23,6 +25,8 @@ let f (x : ('a, empty Lazy.t) result) = | Error (lazy Refl) -> .;; [%%expect{| Line _, characters 16-20: + | Error (lazy Refl) -> .;; + ^^^^ Error: This pattern matches values of type (int, int) eq but a pattern was expected which matches values of type empty = (int, unit) eq diff --git a/testsuite/tests/typing-gadts/pr7432.ml b/testsuite/tests/typing-gadts/pr7432.ml index 4881402957..0eb9b60119 100644 --- a/testsuite/tests/typing-gadts/pr7432.ml +++ b/testsuite/tests/typing-gadts/pr7432.ml @@ -22,6 +22,8 @@ let f : [`L of (s, t) eql | `R of silly] -> 'a = ;; [%%expect{| Line _, characters 2-30: + function `R {silly} -> silly + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: `L Refl diff --git a/testsuite/tests/typing-gadts/pr7518.ml b/testsuite/tests/typing-gadts/pr7518.ml index 793a456e98..7d536321b0 100644 --- a/testsuite/tests/typing-gadts/pr7518.ml +++ b/testsuite/tests/typing-gadts/pr7518.ml @@ -20,10 +20,14 @@ let ok (type a b) (x : (a, b) eq) = [%%expect{| type ('a, 'b) eq = Refl : ('a, 'a) eq Line _, characters 2-54: + ..match x, [] with + | Refl, [(_ : a) | (_ : b)] -> [] Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (Refl, _::_::_) Line _, characters 22-23: + | Refl, [(_ : a) | (_ : b)] -> [] + ^ Warning 12: this sub-pattern is unused. val ok : ('a, 'b) eq -> 'c list = <fun> |}] @@ -34,12 +38,19 @@ let fails (type a b) (x : (a, b) eq) = ;; [%%expect{| Line _, characters 2-90: + ..match x, [] with + | Refl, [(_ : a) | (_ : b)] -> [] + | Refl, [(_ : b) | (_ : a)] -> [] Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (Refl, _::_::_) Line _, characters 22-23: + | Refl, [(_ : a) | (_ : b)] -> [] + ^ Warning 12: this sub-pattern is unused. Line _, characters 4-29: + | Refl, [(_ : b) | (_ : a)] -> [] + ^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 11: this match case is unused. val fails : ('a, 'b) eq -> 'c list = <fun> |}] @@ -48,6 +59,8 @@ val fails : ('a, 'b) eq -> 'c list = <fun> let x = match [] with ["1"] -> 1 | [1.0] -> 2 | [1] -> 3 | _ -> 4;; [%%expect{| Line _, characters 35-40: + let x = match [] with ["1"] -> 1 | [1.0] -> 2 | [1] -> 3 | _ -> 4;; + ^^^^^ Error: This pattern matches values of type float list but a pattern was expected which matches values of type string list Type float is not compatible with type string diff --git a/testsuite/tests/typing-gadts/test.ml b/testsuite/tests/typing-gadts/test.ml index 806329ac0a..4c5fb2e6ec 100644 --- a/testsuite/tests/typing-gadts/test.ml +++ b/testsuite/tests/typing-gadts/test.ml @@ -104,10 +104,15 @@ module Nonexhaustive = ;; [%%expect{| Line _, characters 6-34: + ......function + | C2 x -> x Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: C1 _ Line _, characters 6-77: + ......function + | Foo _ , Foo _ -> true + | Bar _, Bar _ -> true Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (Bar _, Foo _) @@ -153,10 +158,14 @@ module PR6862 = struct end;; [%%expect{| Line _, characters 10-18: + class c (Some x) = object method x : int = x end + ^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: None Line _, characters 10-18: + class d (Just x) = object method x : int = x end + ^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Nothing @@ -184,6 +193,8 @@ module PR6220 = struct end;; [%%expect{| Line _, characters 43-44: + let g : int t -> int = function I -> 1 | _ -> 2 (* warn *) + ^ Warning 56: this match case is unreachable. Consider replacing it with a refutation case '<pat> -> .' module PR6220 : @@ -250,6 +261,8 @@ module PR6801 = struct end;; [%%expect{| Line _, characters 4-50: + ....match x with + | String s -> print_endline s................. Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: Any @@ -272,6 +285,8 @@ module Existential_escape = ;; [%%expect{| Line _, characters 21-22: + let eval (D x) = x + ^ Error: This expression has type $D_'a t but an expression was expected of type 'a The type constructor $D_'a would escape its scope @@ -303,6 +318,8 @@ end ;; [%%expect{| Line _, characters 11-19: + | (IntLit _ | BoolLit _) -> () + ^^^^^^^^ Error: This pattern matches values of type int t but a pattern was expected which matches values of type s t Type int is not compatible with type s @@ -352,6 +369,8 @@ module Propagation : end |}, Principal{| Line _, characters 19-20: + | BoolLit b -> b + ^ Error: This expression has type bool but an expression was expected of type s |}];; @@ -363,10 +382,14 @@ module Normal_constrs = struct end;; [%%expect{| Line _, characters 28-29: + let f = function A -> 1 | B -> 2 + ^ Error: This variant pattern is expected to have type a The constructor B does not belong to type a |}, Principal{| Line _, characters 28-29: + let f = function A -> 1 | B -> 2 + ^ Error: This pattern matches values of type b but a pattern was expected which matches values of type a |}];; @@ -379,6 +402,8 @@ module PR6849 = struct end;; [%%expect{| Line _, characters 6-9: + Foo -> 5 + ^^^ Error: This pattern matches values of type 'a t but a pattern was expected which matches values of type int |}];; @@ -408,6 +433,8 @@ let test : type a. a t -> _ = ;; [%%expect{| Line _, characters 18-30: + function Int -> ky (1 : a) 1 (* fails *) + ^^^^^^^^^^^^ Error: This expression has type a = int but an expression was expected of type 'a This instance of int is ambiguous: @@ -420,6 +447,8 @@ let test : type a. a t -> a = fun x -> ;; [%%expect{| Line _, characters 30-42: + let r = match x with Int -> ky (1 : a) 1 (* fails *) + ^^^^^^^^^^^^ Error: This expression has type a = int but an expression was expected of type 'a This instance of int is ambiguous: @@ -432,6 +461,8 @@ let test : type a. a t -> a = fun x -> ;; [%%expect{| Line _, characters 30-42: + let r = match x with Int -> ky 1 (1 : a) (* fails *) + ^^^^^^^^^^^^ Error: This expression has type a = int but an expression was expected of type 'a This instance of int is ambiguous: @@ -506,6 +537,8 @@ let test2 : type a. a t -> a option = fun x -> ;; (* fails because u : (int | a) option ref *) [%%expect{| Line _, characters 46-48: + begin match x with Int -> u := Some 1; r := !u end; + ^^ Error: This expression has type int option but an expression was expected of type a option Type int is not compatible with type a = int @@ -542,6 +575,8 @@ let we_y1x (type a) (x : a) (v : a t) = [%%expect{| val either : 'a -> 'a -> 'a = <fun> Line _, characters 44-45: + match v with Int -> let y = either 1 x in y + ^ Error: This expression has type a = int but an expression was expected of type 'a This instance of int is ambiguous: @@ -601,6 +636,8 @@ let f (type a) (x : a t) y = ;; (* fails because of aliasing... *) [%%expect{| Line _, characters 46-47: + let module M = struct type b = a let z = (y : b) end + ^ Error: This expression has type a = int but an expression was expected of type b = int This instance of int is ambiguous: @@ -652,6 +689,8 @@ let f : type a b. (a,b) eq -> (<m : a; ..> as 'c) -> (<m : b; ..> as 'c) = [%%expect{| type (_, _) eq = Eq : ('a, 'a) eq Line _, characters 4-90: + ....f : type a b. (a,b) eq -> (<m : a; ..> as 'c) -> (<m : b; ..> as 'c) = + fun Eq o -> o Error: The universal type variable 'b cannot be generalized: it is already bound to another variable. |}];; @@ -661,6 +700,8 @@ let f : type a b. (a,b) eq -> <m : a; ..> -> <m : b; ..> = ;; (* fail *) [%%expect{| Line _, characters 14-15: + fun Eq o -> o + ^ Error: This expression has type < m : a; .. > but an expression was expected of type < m : b; .. > Type a is not compatible with type b = a @@ -672,6 +713,8 @@ let f (type a) (type b) (eq : (a,b) eq) (o : <m : a; ..>) : <m : b; ..> = match eq with Eq -> o ;; (* should fail *) [%%expect{| Line _, characters 22-23: + match eq with Eq -> o ;; (* should fail *) + ^ Error: This expression has type < m : a; .. > but an expression was expected of type < m : b; .. > Type a is not compatible with type b = a @@ -710,6 +753,8 @@ let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > = val f : ('a, 'b) eq -> < m : 'a > -> < m : 'b > = <fun> |}, Principal{| Line _, characters 44-45: + let r : < m : b > = match eq with Eq -> o in (* fail with principal *) + ^ Error: This expression has type < m : a > but an expression was expected of type < m : b > Type a is not compatible with type b = a @@ -724,6 +769,8 @@ let f : type a b. (a,b) eq -> < m : a; .. > -> < m : b > = r;; [%%expect{| Line _, characters 44-45: + let r : < m : b > = match eq with Eq -> o in (* fail *) + ^ Error: This expression has type < m : a; .. > but an expression was expected of type < m : b > Type a is not compatible with type b = a @@ -735,6 +782,8 @@ let f : type a b. (a,b) eq -> [> `A of a] -> [> `A of b] = fun Eq o -> o ;; (* fail *) [%%expect{| Line _, characters 14-15: + fun Eq o -> o ;; (* fail *) + ^ Error: This expression has type [> `A of a ] but an expression was expected of type [> `A of b ] Type a is not compatible with type b = a @@ -742,6 +791,8 @@ Error: This expression has type [> `A of a ] it would escape the scope of its equation |}, Principal{| Line _, characters 9-15: + fun Eq o -> o ;; (* fail *) + ^^^^^^ Error: This expression has type ([> `A of b ] as 'a) -> 'a but an expression was expected of type [> `A of a ] -> [> `A of b ] Types for tag `A are incompatible @@ -751,6 +802,8 @@ let f (type a b) (eq : (a,b) eq) (v : [> `A of a]) : [> `A of b] = match eq with Eq -> v ;; (* should fail *) [%%expect{| Line _, characters 22-23: + match eq with Eq -> v ;; (* should fail *) + ^ Error: This expression has type [> `A of a ] but an expression was expected of type [> `A of b ] Type a is not compatible with type b = a @@ -762,6 +815,8 @@ let f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] = fun Eq o -> o ;; (* fail *) [%%expect{| Line _, characters 4-84: + ....f : type a b. (a,b) eq -> [< `A of a | `B] -> [< `A of b | `B] = + fun Eq o -> o.............. Error: This definition has type ('a, 'b) eq -> ([< `A of 'b & 'a | `B ] as 'c) -> 'c which is less general than 'a0 'b0. ('a0, 'b0) eq -> 'c -> 'c @@ -789,6 +844,8 @@ let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] = val f : ('a, 'b) eq -> [ `A of 'a | `B ] -> [ `A of 'b | `B ] = <fun> |}, Principal{| Line _, characters 49-50: + let r : [`A of b | `B] = match eq with Eq -> o in (* fail with principal *) + ^ Error: This expression has type [ `A of a | `B ] but an expression was expected of type [ `A of b | `B ] Type a is not compatible with type b = a @@ -803,6 +860,8 @@ let f : type a b. (a,b) eq -> [> `A of a | `B] -> [`A of b | `B] = r;; [%%expect{| Line _, characters 49-50: + let r : [`A of b | `B] = match eq with Eq -> o in (* fail *) + ^ Error: This expression has type [> `A of a | `B ] but an expression was expected of type [ `A of b | `B ] Type a is not compatible with type b = a @@ -858,6 +917,13 @@ let f : type a. a ty -> a t -> int = fun x y -> ;; (* warn *) [%%expect{| Line _, characters 2-153: + ..match x, y with + | _, A z -> z + | _, B z -> if z then 1 else 2 + | _, C z -> truncate z + | TE TC, D [|1.0|] -> 14 + | TA, D 0 -> -1 + | TA, D z -> z Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (TE TC, D [| 0. |]) @@ -875,6 +941,8 @@ let f : type a. a ty -> a t -> int = fun x y -> ;; (* fail *) [%%expect{| Line _, characters 6-13: + | D [|1.0|], TE TC -> 14 + ^^^^^^^ Error: This pattern matches values of type 'a array but a pattern was expected which matches values of type a |}];; @@ -893,6 +961,8 @@ let f : type a. a ty -> a t -> int = fun x y -> [%%expect{| type ('a, 'b) pair = { right : 'a; left : 'b; } Line _, characters 25-32: + | {left=TE TC; right=D [|1.0|]} -> 14 + ^^^^^^^ Error: This pattern matches values of type 'a array but a pattern was expected which matches values of type a |}];; @@ -911,6 +981,13 @@ let f : type a. a ty -> a t -> int = fun x y -> [%%expect{| type ('a, 'b) pair = { left : 'a; right : 'b; } Line _, characters 2-244: + ..match {left=x; right=y} with + | {left=_; right=A z} -> z + | {left=_; right=B z} -> if z then 1 else 2 + | {left=_; right=C z} -> truncate z + | {left=TE TC; right=D [|1.0|]} -> 14 + | {left=TA; right=D 0} -> -1 + | {left=TA; right=D z} -> z Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: {left=TE TC; right=D [| 0. |]} @@ -929,6 +1006,8 @@ let f : type a b. (a M.t, b M.t) eq -> (a, b) eq = [%%expect{| module M : sig type 'a t val eq : ('a t, 'b t) eq end Line _, characters 17-19: + function Eq -> Eq (* fail *) + ^^ Error: This expression has type (a, a) eq but an expression was expected of type (a, b) eq Type a is not compatible with type b @@ -983,6 +1062,8 @@ let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) = type _ int_foo = IF_constr : < foo : int; .. > int_foo type _ int_bar = IB_constr : < bar : int; .. > int_bar Line _, characters 3-4: + (x:<foo:int>) + ^ Error: This expression has type t = < foo : int; .. > but an expression was expected of type < foo : int > Type $0 = < bar : int; .. > is not compatible with type < > @@ -995,6 +1076,8 @@ let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) = ;; [%%expect{| Line _, characters 3-4: + (x:<foo:int;bar:int>) + ^ Error: This expression has type t = < foo : int; .. > but an expression was expected of type < bar : int; foo : int > Type $0 = < bar : int; .. > is not compatible with type < bar : int > @@ -1007,6 +1090,8 @@ let g (type t) (x:t) (e : t int_foo) (e' : t int_bar) = ;; [%%expect{| Line _, characters 2-26: + (x:<foo:int;bar:int;..>) + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type < bar : int; foo : int; .. > but an expression was expected of type 'a The type constructor $1 would escape its scope diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml b/testsuite/tests/typing-gadts/yallop_bugs.ml index b9158cb3b8..5e86e91198 100644 --- a/testsuite/tests/typing-gadts/yallop_bugs.ml +++ b/testsuite/tests/typing-gadts/yallop_bugs.ml @@ -19,6 +19,8 @@ let magic : 'a 'b. 'a -> 'b = [%%expect{| type (_, _) eq = Refl : ('a, 'a) eq Line _, characters 44-52: + let f (Refl : (a T.t, b T.t) eq) = (x :> b) + ^^^^^^^^ Error: Type a is not a subtype of b |}];; @@ -36,6 +38,8 @@ let magic : 'a 'b. 'a -> 'b = ;; [%%expect{| Line _, characters 0-36: + type (_, +_) eq = Refl : ('a, 'a) eq + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In this GADT definition, the variance of some parameter cannot be checked |}];; @@ -53,6 +57,9 @@ let check : type s . s t * s -> bool = function [%%expect{| type _ t = IntLit : int t | BoolLit : bool t Line _, characters 39-99: + .......................................function + | BoolLit, false -> false + | IntLit , 6 -> false Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (IntLit, 0) @@ -68,6 +75,9 @@ let check : type s . (s t, s) pair -> bool = function [%%expect{| type ('a, 'b) pair = { fst : 'a; snd : 'b; } Line _, characters 45-134: + .............................................function + | {fst = BoolLit; snd = false} -> false + | {fst = IntLit ; snd = 6} -> false Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: {fst=IntLit; snd=0} diff --git a/testsuite/tests/typing-immediate/immediate.ml b/testsuite/tests/typing-immediate/immediate.ml index f8e110327d..caa6ee60c5 100644 --- a/testsuite/tests/typing-immediate/immediate.ml +++ b/testsuite/tests/typing-immediate/immediate.ml @@ -107,6 +107,8 @@ module B = struct end;; [%%expect{| Line _, characters 2-31: + type t = string [@@immediate] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Types marked with the immediate attribute must be non-pointer types like int or bool |}];; @@ -118,6 +120,8 @@ module C = struct end;; [%%expect{| Line _, characters 2-26: + type s = t [@@immediate] + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: Types marked with the immediate attribute must be non-pointer types like int or bool |}];; @@ -128,6 +132,9 @@ module D : sig type t [@@immediate] end = struct end;; [%%expect{| Line _, characters 42-70: + ..........................................struct + type t = string + end.. Error: Signature mismatch: Modules do not match: sig type t = string end @@ -145,6 +152,8 @@ module M_invalid : S = struct type t = string end;; module FM_invalid = F (struct type t = string end);; [%%expect{| Line _, characters 23-49: + module M_invalid : S = struct type t = string end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Signature mismatch: Modules do not match: sig type t = string end is not included in S Type declarations do not match: @@ -161,6 +170,8 @@ module E = struct end;; [%%expect{| Line _, characters 2-26: + type t = s [@@immediate] + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: Types marked with the immediate attribute must be non-pointer types like int or bool |}];; diff --git a/testsuite/tests/typing-misc/constraints.ml b/testsuite/tests/typing-misc/constraints.ml index b72a78ebcb..a47cf96486 100644 --- a/testsuite/tests/typing-misc/constraints.ml +++ b/testsuite/tests/typing-misc/constraints.ml @@ -5,26 +5,36 @@ type 'a t = [`A of 'a t t] as 'a;; (* fails *) [%%expect{| Line _, characters 0-32: + type 'a t = [`A of 'a t t] as 'a;; (* fails *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The definition of t contains a cycle: 'a t t as 'a |}, Principal{| Line _, characters 0-32: + type 'a t = [`A of 'a t t] as 'a;; (* fails *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The definition of t contains a cycle: [ `A of 'a t t ] as 'a |}];; type 'a t = [`A of 'a t t];; (* fails *) [%%expect{| Line _, characters 0-26: + type 'a t = [`A of 'a t t];; (* fails *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In the definition of t, type 'a t t should be 'a t |}];; type 'a t = [`A of 'a t t] constraint 'a = 'a t;; (* fails since 4.04 *) [%%expect{| Line _, characters 0-47: + type 'a t = [`A of 'a t t] constraint 'a = 'a t;; (* fails since 4.04 *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The type abbreviation t is cyclic |}];; type 'a t = [`A of 'a t] constraint 'a = 'a t;; (* fails since 4.04 *) [%%expect{| Line _, characters 0-45: + type 'a t = [`A of 'a t] constraint 'a = 'a t;; (* fails since 4.04 *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The type abbreviation t is cyclic |}];; type 'a t = [`A of 'a] as 'a;; @@ -36,6 +46,8 @@ type 'a t = [ `A of 'b ] as 'b constraint 'a = [ `A of 'a ] type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *) [%%expect{| Line _, characters 0-41: + type 'a v = [`A of u v] constraint 'a = t and t = u and u = t;; (* fails *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The definition of v contains a cycle: t |}];; @@ -62,6 +74,8 @@ end ;; (* fails *) [%%expect{| Line _, characters 2-44: + and 'o abs constraint 'o = 'o is_an_object + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The definition of abs contains a cycle: 'a is_an_object as 'a |}];; @@ -80,6 +94,8 @@ module PR6505a : val y : (< > is_an_object, < > is_an_object) abs end Line _, characters 8-17: + let _ = PR6505a.y#bang;; (* fails *) + ^^^^^^^^^ Error: This expression has type (< > PR6505a.is_an_object, < > PR6505a.is_an_object) PR6505a.abs It has no method bang @@ -91,6 +107,8 @@ module PR6505a : val y : (< >, < >) abs end Line _, characters 8-17: + let _ = PR6505a.y#bang;; (* fails *) + ^^^^^^^^^ Error: This expression has type (< >, < >) PR6505a.abs It has no method bang |}] @@ -109,6 +127,8 @@ module PR6505b : val x : (([> `Foo of int ] as 'a) is_an_object, 'a is_an_object) abs end Line _, characters 23-57: + let () = print_endline (match PR6505b.x with `Bar s -> s);; (* fails *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: `Foo _ diff --git a/testsuite/tests/typing-misc/labels.ml b/testsuite/tests/typing-misc/labels.ml index 55462e6857..a2b5c3642b 100644 --- a/testsuite/tests/typing-misc/labels.ml +++ b/testsuite/tests/typing-misc/labels.ml @@ -8,6 +8,8 @@ f ?x:0;; [%%expect{| val f : x:int -> int = <fun> Line _, characters 5-6: + f ?x:0;; + ^ Warning 43: the label x is not optional. - : int = 1 |}];; @@ -26,6 +28,8 @@ val g : ?x:'a -> unit -> unit = <fun> foo (fun ?opt () -> ()) ;; (* fails *) [%%expect{| Line _, characters 4-23: + foo (fun ?opt () -> ()) ;; (* fails *) + ^^^^^^^^^^^^^^^^^^^ Error: This function should have type unit -> unit but its first argument is labelled ?opt |}];; diff --git a/testsuite/tests/typing-misc/occur_check.ml b/testsuite/tests/typing-misc/occur_check.ml index b6a8e6c78d..90c5224e38 100644 --- a/testsuite/tests/typing-misc/occur_check.ml +++ b/testsuite/tests/typing-misc/occur_check.ml @@ -9,6 +9,8 @@ let f (g : 'a list -> 'a t -> 'a) s = g s s;; [%%expect{| type 'a t = 'a Line _, characters 42-43: + let f (g : 'a list -> 'a t -> 'a) s = g s s;; + ^ Error: This expression has type 'a list but an expression was expected of type 'a t = 'a The type variable 'a occurs inside 'a list @@ -16,6 +18,8 @@ Error: This expression has type 'a list let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;; [%%expect{| Line _, characters 42-43: + let f (g : 'a * 'b -> 'a t -> 'a) s = g s s;; + ^ Error: This expression has type 'a * 'b but an expression was expected of type 'a t = 'a The type variable 'a occurs inside 'a * 'b diff --git a/testsuite/tests/typing-misc/polyvars.ml b/testsuite/tests/typing-misc/polyvars.ml index 8ef45d9f8b..cee4db68aa 100644 --- a/testsuite/tests/typing-misc/polyvars.ml +++ b/testsuite/tests/typing-misc/polyvars.ml @@ -7,6 +7,8 @@ let f (x : [`A]) = match x with #ab -> 1;; [%%expect{| type ab = [ `A | `B ] Line _, characters 32-35: + let f (x : [`A]) = match x with #ab -> 1;; + ^^^ Error: This pattern matches values of type [? `A | `B ] but a pattern was expected which matches values of type [ `A ] The second variant type does not allow tag(s) `B @@ -14,11 +16,15 @@ Error: This pattern matches values of type [? `A | `B ] let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);; [%%expect{| Line _, characters 31-34: + let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);; + ^^^ Error: This pattern matches values of type [? `B ] but a pattern was expected which matches values of type [ `A ] The second variant type does not allow tag(s) `B |}, Principal{| Line _, characters 31-34: + let f x = ignore (match x with #ab -> 1); ignore (x : [`A]);; + ^^^ Error: This pattern matches values of type [? `B ] but a pattern was expected which matches values of type [ `A ] Types for tag `B are incompatible @@ -26,11 +32,15 @@ Error: This pattern matches values of type [? `B ] let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);; [%%expect{| Line _, characters 34-36: + let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);; + ^^ Error: This pattern matches values of type [? `B ] but a pattern was expected which matches values of type [ `A ] The second variant type does not allow tag(s) `B |}, Principal{| Line _, characters 34-36: + let f x = ignore (match x with `A|`B -> 1); ignore (x : [`A]);; + ^^ Error: This pattern matches values of type [? `B ] but a pattern was expected which matches values of type [ `A ] Types for tag `B are incompatible @@ -39,12 +49,16 @@ Error: This pattern matches values of type [? `B ] let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *) [%%expect{| Line _, characters 49-51: + let f (x : [< `A | `B]) = match x with `A | `B | `C -> 0;; (* warn *) + ^^ Warning 12: this sub-pattern is unused. val f : [< `A | `B ] -> int = <fun> |}];; let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *) [%%expect{| Line _, characters 47-49: + let f (x : [`A | `B]) = match x with `A | `B | `C -> 0;; (* fail *) + ^^ Error: This pattern matches values of type [? `C ] but a pattern was expected which matches values of type [ `A | `B ] The second variant type does not allow tag(s) `C @@ -67,6 +81,8 @@ let f : ([`A | `B ] as 'a) -> [> 'a] -> unit = fun x (y : [> 'a]) -> ();; let f (x : [`A | `B] as 'a) (y : [> 'a]) = ();; [%%expect{| Line _, characters 61-63: + let f : ([`A | `B ] as 'a) -> [> 'a] -> unit = fun x (y : [> 'a]) -> ();; + ^^ Error: The type 'a does not expand to a polymorphic variant type Hint: Did you mean `a? |}] diff --git a/testsuite/tests/typing-misc/pr6939-flat-float-array.ml b/testsuite/tests/typing-misc/pr6939-flat-float-array.ml index b449acc6da..63e594415f 100644 --- a/testsuite/tests/typing-misc/pr6939-flat-float-array.ml +++ b/testsuite/tests/typing-misc/pr6939-flat-float-array.ml @@ -6,13 +6,19 @@ let rec x = [| x |]; 1.;; [%%expect{| Line _, characters 12-19: + let rec x = [| x |]; 1.;; + ^^^^^^^ Warning 10: this expression should have type unit. Line _, characters 12-23: + let rec x = [| x |]; 1.;; + ^^^^^^^^^^^ Error: This kind of expression is not allowed as right-hand side of `let rec' |}];; let rec x = let u = [|y|] in 10. and y = 1.;; [%%expect{| Line _, characters 12-32: + let rec x = let u = [|y|] in 10. and y = 1.;; + ^^^^^^^^^^^^^^^^^^^^ Error: This kind of expression is not allowed as right-hand side of `let rec' |}];; diff --git a/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml b/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml index 76a990a7bb..8440976194 100644 --- a/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml +++ b/testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml @@ -6,6 +6,8 @@ let rec x = [| x |]; 1.;; [%%expect{| Line _, characters 12-19: + let rec x = [| x |]; 1.;; + ^^^^^^^ Warning 10: this expression should have type unit. val x : float = 1. |}];; @@ -13,6 +15,8 @@ val x : float = 1. let rec x = let u = [|y|] in 10. and y = 1.;; [%%expect{| Line _, characters 16-17: + let rec x = let u = [|y|] in 10. and y = 1.;; + ^ Warning 26: unused variable u. val x : float = 10. val y : float = 1. diff --git a/testsuite/tests/typing-misc/pr7103.ml b/testsuite/tests/typing-misc/pr7103.ml index 9f7860e281..706e37310c 100644 --- a/testsuite/tests/typing-misc/pr7103.ml +++ b/testsuite/tests/typing-misc/pr7103.ml @@ -21,6 +21,8 @@ val h : [> `b ] t -> unit = <fun> let _ = fun (x : a t) -> f x;; [%%expect{| Line _, characters 27-28: + let _ = fun (x : a t) -> f x;; + ^ Error: This expression has type a t but an expression was expected of type (< .. > as 'a) t Type a is not compatible with type < .. > as 'a @@ -29,6 +31,8 @@ Error: This expression has type a t but an expression was expected of type let _ = fun (x : a t) -> g x;; [%%expect{| Line _, characters 27-28: + let _ = fun (x : a t) -> g x;; + ^ Error: This expression has type a t but an expression was expected of type ([< `b ] as 'a) t Type a is not compatible with type [< `b ] as 'a @@ -37,6 +41,8 @@ Error: This expression has type a t but an expression was expected of type let _ = fun (x : a t) -> h x;; [%%expect{| Line _, characters 27-28: + let _ = fun (x : a t) -> h x;; + ^ Error: This expression has type a t but an expression was expected of type ([> `b ] as 'a) t Type a is not compatible with type [> `b ] as 'a diff --git a/testsuite/tests/typing-misc/pr7228.ml b/testsuite/tests/typing-misc/pr7228.ml index 62b7a1ee61..ff48b07312 100644 --- a/testsuite/tests/typing-misc/pr7228.ml +++ b/testsuite/tests/typing-misc/pr7228.ml @@ -15,5 +15,7 @@ fun (A r) -> r.x <- 42;; [%%expect{| type t = private A of { mutable x : int; } Line _, characters 15-16: + fun (A r) -> r.x <- 42;; + ^ Error: Cannot assign field x of the private type t.A |}];; diff --git a/testsuite/tests/typing-misc/pr7668_bad.ml b/testsuite/tests/typing-misc/pr7668_bad.ml index 1bfb46191a..8eca88d277 100644 --- a/testsuite/tests/typing-misc/pr7668_bad.ml +++ b/testsuite/tests/typing-misc/pr7668_bad.ml @@ -21,6 +21,8 @@ val partition_map : ('a -> [< `Left of 'b | `Right of 'c ]) -> 'a list -> 'b list * 'c list = <fun> Line _, characters 35-96: + ...................................partition_map (fun x -> if x then `Left () + else `Right ()) xs Error: This expression has type unit list * unit list but an expression was expected of type int list * int list Type unit is not compatible with type int diff --git a/testsuite/tests/typing-misc/printing.ml b/testsuite/tests/typing-misc/printing.ml index f239705e4d..48a8c7ed8c 100644 --- a/testsuite/tests/typing-misc/printing.ml +++ b/testsuite/tests/typing-misc/printing.ml @@ -7,6 +7,8 @@ type t = [ 'A_name | `Hi ];; [%%expect{| Line _, characters 11-18: + type t = [ 'A_name | `Hi ];; + ^^^^^^^ Error: The type 'A_name does not expand to a polymorphic variant type Hint: Did you mean `A_name? |}];; diff --git a/testsuite/tests/typing-misc/records.ml b/testsuite/tests/typing-misc/records.ml index 7dd21ecdfc..4d336b9f82 100644 --- a/testsuite/tests/typing-misc/records.ml +++ b/testsuite/tests/typing-misc/records.ml @@ -8,11 +8,15 @@ type t = {x:int;y:int};; [%%expect{| type t = { x : int; y : int; } Line _, characters 5-6: + {x=3;z=2};; + ^ Error: Unbound record field z |}];; fun {x=3;z=2} -> ();; [%%expect{| Line _, characters 9-10: + fun {x=3;z=2} -> ();; + ^ Error: Unbound record field z |}];; @@ -20,6 +24,8 @@ Error: Unbound record field z {x=3; contents=2};; [%%expect{| Line _, characters 6-14: + {x=3; contents=2};; + ^^^^^^^^ Error: The record field contents belongs to the type 'a ref but is mixed here with fields of type t |}];; @@ -30,11 +36,15 @@ type u = private {mutable u:int};; [%%expect{| type u = private { mutable u : int; } Line _, characters 0-5: + {u=3};; + ^^^^^ Error: Cannot create values of the private type u |}];; fun x -> x.u <- 3;; [%%expect{| Line _, characters 11-12: + fun x -> x.u <- 3;; + ^ Error: Cannot assign field u of the private type u |}];; @@ -61,6 +71,8 @@ let f (r: int) = r.y <- 3;; [%%expect{| type foo = { mutable y : int; } Line _, characters 17-18: + let f (r: int) = r.y <- 3;; + ^ Error: This expression has type int but an expression was expected of type foo |}];; @@ -73,6 +85,8 @@ let f (r: bar) = ({ r with z = 3 } : foo) type foo = { y : int; z : int; } type bar = { x : int; } Line _, characters 20-21: + let f (r: bar) = ({ r with z = 3 } : foo) + ^ Error: This expression has type bar but an expression was expected of type foo |}];; @@ -82,12 +96,16 @@ let r : foo = { ZZZ.x = 2 };; [%%expect{| type foo = { x : int; } Line _, characters 16-21: + let r : foo = { ZZZ.x = 2 };; + ^^^^^ Error: Unbound module ZZZ |}];; (ZZZ.X : int option);; [%%expect{| Line _, characters 1-6: + (ZZZ.X : int option);; + ^^^^^ Error: Unbound module ZZZ |}];; @@ -95,6 +113,8 @@ Error: Unbound module ZZZ let f (x : Complex.t) = x.Complex.z;; [%%expect{| Line _, characters 26-35: + let f (x : Complex.t) = x.Complex.z;; + ^^^^^^^^^ Error: Unbound record field Complex.z |}];; @@ -102,6 +122,8 @@ Error: Unbound record field Complex.z { true with contents = 0 };; [%%expect{| Line _, characters 2-6: + { true with contents = 0 };; + ^^^^ Error: This expression has type bool but an expression was expected of type 'a ref |}];; diff --git a/testsuite/tests/typing-misc/variant.ml b/testsuite/tests/typing-misc/variant.ml index 737582f683..00ad4ea3d9 100644 --- a/testsuite/tests/typing-misc/variant.ml +++ b/testsuite/tests/typing-misc/variant.ml @@ -12,6 +12,10 @@ end = struct end;; [%%expect{| Line _, characters 6-61: + ......struct + type t = A | B + let f = function A | B -> 0 + end.. Error: Signature mismatch: Modules do not match: sig type t = X.t = A | B val f : t -> int end diff --git a/testsuite/tests/typing-misc/wellfounded.ml b/testsuite/tests/typing-misc/wellfounded.ml index dc22416e86..1721404881 100644 --- a/testsuite/tests/typing-misc/wellfounded.ml +++ b/testsuite/tests/typing-misc/wellfounded.ml @@ -16,5 +16,7 @@ let f : type t. t prod -> _ = function Prod -> [%%expect{| type _ prod = Prod : ('a * 'y) prod Line _, characters 6-20: + type d = d * d + ^^^^^^^^^^^^^^ Error: The type abbreviation d is cyclic |}];; diff --git a/testsuite/tests/typing-modules/Test.ml b/testsuite/tests/typing-modules/Test.ml index 0ba4e9eafe..1da12967c1 100644 --- a/testsuite/tests/typing-modules/Test.ml +++ b/testsuite/tests/typing-modules/Test.ml @@ -69,6 +69,8 @@ module M : sig type -'a t = private int end = ;; [%%expect{| Line _, characters 2-37: + struct type +'a t = private int end + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Signature mismatch: Modules do not match: sig type +'a t = private int end @@ -90,6 +92,8 @@ module type B = A with type t = u;; (* fail *) module type A = sig type t = X of int end type u = X of bool Line _, characters 23-33: + module type B = A with type t = u;; (* fail *) + ^^^^^^^^^^ Error: This variant or record definition does not match that of type u The types for field X are not equal. |}];; @@ -100,6 +104,8 @@ Error: This variant or record definition does not match that of type u module type S = sig exception Foo of int exception Foo of bool end;; [%%expect{| Line _, characters 52-55: + module type S = sig exception Foo of int exception Foo of bool end;; + ^^^ Error: Multiple definition of the extension constructor name Foo. Names must be unique in a given structure or signature. |}];; @@ -111,5 +117,7 @@ F.x;; (* fail *) [%%expect{| module F : functor (X : sig end) -> sig val x : int end Line _, characters 0-3: + F.x;; (* fail *) + ^^^ Error: The module F is a functor, not a structure |}];; diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml index 556760c45f..f719c99b95 100644 --- a/testsuite/tests/typing-modules/aliases.ml +++ b/testsuite/tests/typing-modules/aliases.ml @@ -553,6 +553,8 @@ module type S = end module Int2 : sig type t = int val compare : 'a -> 'a -> int end Line _, characters 10-30: + include S with module I := I + ^^^^^^^^^^^^^^^^^^^^ Error: In this `with' constraint, the new definition of I does not match its original definition in the constrained signature: Modules do not match: (module Int2) is not included in (module Int) diff --git a/testsuite/tests/typing-modules/firstclass.ml b/testsuite/tests/typing-modules/firstclass.ml index f48627c2ad..18679d1b0a 100644 --- a/testsuite/tests/typing-modules/firstclass.ml +++ b/testsuite/tests/typing-modules/firstclass.ml @@ -30,6 +30,8 @@ val g2 : (module S2 with type t = int and type u = bool) -> (module S') = <fun> val h : (module S2 with type t = 'a) -> (module S with type t = 'a) = <fun> Line _, characters 3-4: + (x : (module S'));; (* fail *) + ^ Error: This expression has type (module S2 with type t = int and type u = bool) but an expression was expected of type (module S') @@ -42,6 +44,8 @@ let g3 x = [%%expect{| module type S3 = sig type u type t val x : int end Line _, characters 2-67: + (x : (module S3 with type t = 'a and type u = 'b) :> (module S'));; (* fail *) + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Type (module S3 with type t = int and type u = bool) is not a subtype of (module S') |}];; diff --git a/testsuite/tests/typing-modules/generative.ml b/testsuite/tests/typing-modules/generative.ml index aa8e269bb8..75cc7ae7b7 100644 --- a/testsuite/tests/typing-modules/generative.ml +++ b/testsuite/tests/typing-modules/generative.ml @@ -30,6 +30,8 @@ module F : functor () -> S module G (X : sig end) : S = F ();; (* fail *) [%%expect{| Line _, characters 29-33: + module G (X : sig end) : S = F ();; (* fail *) + ^^^^ Error: This expression creates fresh types. It is not allowed inside applicative functors. |}];; @@ -48,6 +50,8 @@ module M : S module M = F(U);; (* fail *) [%%expect{| Line _, characters 11-12: + module M = F(U);; (* fail *) + ^ Error: This is a generative functor. It can only be applied to () |}];; @@ -57,6 +61,8 @@ module F2 : functor () -> sig end = F1;; (* fail *) [%%expect{| module F1 : functor (X : sig end) -> sig end Line _, characters 36-38: + module F2 : functor () -> sig end = F1;; (* fail *) + ^^ Error: Signature mismatch: Modules do not match: functor (X : sig end) -> sig end @@ -68,6 +74,8 @@ module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) [%%expect{| module F3 : functor () -> sig end Line _, characters 47-49: + module F4 : functor (X : sig end) -> sig end = F3;; (* fail *) + ^^ Error: Signature mismatch: Modules do not match: functor () -> sig end diff --git a/testsuite/tests/typing-modules/pr6394.ml b/testsuite/tests/typing-modules/pr6394.ml index 6408d7aab5..82f4cb775d 100644 --- a/testsuite/tests/typing-modules/pr6394.ml +++ b/testsuite/tests/typing-modules/pr6394.ml @@ -11,6 +11,10 @@ end = struct end;; [%%expect{| Line _, characters 6-63: + ......struct + type t = A | B + let f = function A | B -> 0 + end.. Error: Signature mismatch: Modules do not match: sig type t = X.t = A | B val f : t -> int end diff --git a/testsuite/tests/typing-modules/pr7207.ml b/testsuite/tests/typing-modules/pr7207.ml index 1c3f9563f4..c18176fc50 100644 --- a/testsuite/tests/typing-modules/pr7207.ml +++ b/testsuite/tests/typing-modules/pr7207.ml @@ -7,5 +7,7 @@ type t = F(Does_not_exist).t;; [%%expect{| module F : functor (X : sig end) -> sig type t = int end Line _, characters 9-28: + type t = F(Does_not_exist).t;; + ^^^^^^^^^^^^^^^^^^^ Error: Unbound module Does_not_exist |}];; diff --git a/testsuite/tests/typing-modules/recursive.ml b/testsuite/tests/typing-modules/recursive.ml index 33e7161e33..dd844c29ce 100644 --- a/testsuite/tests/typing-modules/recursive.ml +++ b/testsuite/tests/typing-modules/recursive.ml @@ -7,5 +7,7 @@ module rec T : sig type t = T.t end = T;; [%%expect{| Line _, characters 15-35: + module rec T : sig type t = T.t end = T;; + ^^^^^^^^^^^^^^^^^^^^ Error: The type abbreviation T.t is cyclic |}] diff --git a/testsuite/tests/typing-poly/poly.ml b/testsuite/tests/typing-poly/poly.ml index c0750699a0..3c841101aa 100644 --- a/testsuite/tests/typing-poly/poly.ml +++ b/testsuite/tests/typing-poly/poly.ml @@ -233,6 +233,8 @@ class ['a] ostream1 : end |}, Principal{| Line _, characters 4-16: + self#tl#fold ~f ~init:(f self#hd init) + ^^^^^^^^^^^^ Warning 18: this use of a polymorphic method is not principal. class ['a] ostream1 : hd:'a -> @@ -390,6 +392,8 @@ val c : circle = <obj> val d : float = 11. val f : < m : 'a. 'a -> 'a > -> < m : 'b. 'b -> 'b > = <fun> Line _, characters 41-42: + let f (x : < m : 'a. 'a -> 'a list >) = (x : < m : 'b. 'b -> 'c >) + ^ Error: This expression has type < m : 'b. 'b -> 'b list > but an expression was expected of type < m : 'b. 'b -> 'c > The universal variable 'b would escape its scope @@ -440,6 +444,8 @@ end ;; [%%expect {| Line _, characters 12-17: + method id x = x + ^^^^^ Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'a |}];; @@ -450,6 +456,8 @@ end ;; [%%expect {| Line _, characters 12-17: + method id x = x + ^^^^^ Error: This method has type 'a -> 'a which is less general than 'b. 'b -> 'a |}];; @@ -461,6 +469,8 @@ end ;; [%%expect {| Line _, characters 12-17: + method id _ = x + ^^^^^ Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a |}];; @@ -475,6 +485,10 @@ end ;; [%%expect {| Line _, characters 12-79: + ............x = + match r with + None -> r <- Some x; x + | Some y -> y Error: This method has type 'b -> 'b which is less general than 'a. 'a -> 'a |}];; @@ -500,6 +514,8 @@ let f4 f = ignore(f : id); f#id 1, f#id true val f1 : id -> int * bool = <fun> val f2 : id -> int * bool = <fun> Line _, characters 24-28: + let f3 f = f#id 1, f#id true + ^^^^ Error: This expression has type bool but an expression was expected of type int |}];; @@ -528,6 +544,8 @@ type 'a foo = 'a foo list class id2 : object method id : 'a -> 'a method mono : int -> int end val app : int * bool = (1, true) Line _, characters 0-25: + type 'a foo = 'a foo list + ^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The type abbreviation foo is cyclic |}];; @@ -736,6 +754,8 @@ bad2.bad2 <- Some (ref None);; [%%expect {| type bad = { bad : 'a. 'a option ref; } Line _, characters 17-25: + let bad = {bad = ref None};; + ^^^^^^^^ Error: This field value has type 'b option ref which is less general than 'a. 'a option ref |}];; @@ -789,6 +809,8 @@ and virtual int_list = object method virtual visit : 'a.('a visitor -> 'a) end;; [%%expect {| Line _, characters 30-51: + object method virtual visit : 'a.('a visitor -> 'a) end;; + ^^^^^^^^^^^^^^^^^^^^^ Error: The universal type variable 'a cannot be generalized: it escapes its scope. |}];; @@ -814,6 +836,8 @@ type t = { f : 'a 'b. ('b -> (#ct as 'a) -> 'b) -> 'b; } type t = u and u = t;; [%%expect {| Line _, characters 0-10: + type t = u and u = t;; + ^^^^^^^^^^ Error: The definition of t contains a cycle: u |}];; @@ -830,6 +854,8 @@ type t = [ `A of t a ] type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;; [%%expect {| Line _, characters 50-59: + type ('a,'b) t constraint 'a = 'b and ('a,'b) u = ('a,'b) t;; + ^^^^^^^^^ Error: Constraints are not satisfied in this type. Type ('a, 'b) t should be an instance of ('c, 'c) t |}];; @@ -848,6 +874,8 @@ type 'a u = 'a and 'a v = 'a u t constraint 'a = int;; [%%expect {| type 'a t constraint 'a = int Line _, characters 26-32: + type 'a u = 'a and 'a v = 'a u t;; + ^^^^^^ Error: Constraints are not satisfied in this type. Type 'a u t should be an instance of int t |}];; @@ -861,6 +889,8 @@ type 'a u = 'a and 'a v = 'a u t constraint 'a = int;; type g = int type 'a t = unit constraint 'a = g Line _, characters 26-32: + type 'a u = 'a and 'a v = 'a u t;; + ^^^^^^ Error: Constraints are not satisfied in this type. Type 'a u t should be an instance of g t |}];; @@ -869,6 +899,8 @@ Error: Constraints are not satisfied in this type. type 'a u = < m : 'a v > and 'a v = 'a list u;; [%%expect {| Line _, characters 0-24: + type 'a u = < m : 'a v > and 'a v = 'a list u;; + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: In the definition of v, type 'a list u should be 'a u |}];; @@ -916,22 +948,32 @@ type t = A | B - : t * [< `A | `B ] -> int = <fun> - : [< `A | `B ] * t -> int = <fun> Line _, characters 0-41: + function (`A|`B), _ -> 0 | _,(`A|`B) -> 1;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (`AnyExtraTag, `AnyExtraTag) - : [> `A | `B ] * [> `A | `B ] -> int = <fun> Line _, characters 0-29: + function `B,1 -> 1 | _,1 -> 2;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (_, 0) Line _, characters 21-24: + function `B,1 -> 1 | _,1 -> 2;; + ^^^ Warning 11: this match case is unused. - : [< `B ] * int -> int = <fun> Line _, characters 0-29: + function 1,`B -> 1 | 1,_ -> 2;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 8: this pattern-matching is not exhaustive. Here is an example of a case that is not matched: (0, _) Line _, characters 21-24: + function 1,`B -> 1 | 1,_ -> 2;; + ^^^ Warning 11: this match case is unused. - : int * [< `B ] -> int = <fun> |}];; @@ -941,6 +983,8 @@ type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b] and ('a, 'b) b = 'b -> unit constraint 'b = [> `A of ('a, 'b) a as 'a];; [%%expect {| Line _, characters 0-71: + type ('a, 'b) a = 'a -> unit constraint 'a = [> `B of ('a, 'b) b as 'b] + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: The definition of a contains a cycle: [> `B of ('a, 'b) b as 'b ] as 'a |}];; @@ -1017,10 +1061,14 @@ class c : object method m : int end val f : unit -> c = <fun> val f : unit -> c = <fun> Line _, characters 11-60: + let f () = object method private n = 1 method m = {<>}#n end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Warning 15: the following private methods were made public implicitly: n. val f : unit -> < m : int; n : int > = <fun> Line _, characters 11-56: + let f () = object (self:c) method n = 1 method m = 2 end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This object is expected to have type c but actually has type < m : int; n : 'a > The first object type has no method n @@ -1037,6 +1085,8 @@ type bar' = <m: 'a. 'a * 'a bar > let f (x : foo') = (x : bar');; [%%expect {| Line _, characters 3-4: + (x : <m : 'a. 'a * (<m:'b. 'a * <m:'c. 'c * 'bar> > as 'bar) >);; + ^ Error: This expression has type < m : 'a. 'a * < m : 'a * 'b > > as 'b but an expression was expected of type < m : 'a. 'a * (< m : 'a * < m : 'c. 'c * 'd > > as 'd) > @@ -1054,6 +1104,8 @@ let f x = :> <m : 'a. 'a -> ('a * 'foo)> as 'foo);; [%%expect {| Line _, characters 3-4: + (x : <m : 'b. 'b * ('b * <m : 'c. 'c * ('c * 'bar)>)> as 'bar);; + ^ Error: This expression has type < m : 'b. 'b * ('b * < m : 'c. 'c * 'a > as 'a) > but an expression was expected of type @@ -1069,6 +1121,8 @@ module M = struct type t = <m : 'a. 'a * ('a * 'foo)> as 'foo end;; [%%expect {| Line _, characters 2-64: + = struct let f (x : <m : 'a. 'a * ('a * 'foo)> as 'foo) = () end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Signature mismatch: Modules do not match: sig val f : (< m : 'a. 'a * ('a * 'b) > as 'b) -> unit end @@ -1127,6 +1181,8 @@ type v = private [> t ] type u = private [< t ] - : u -> v = <fun> Line _, characters 9-21: + fun x -> (x : v :> u);; + ^^^^^^^^^^^^ Error: Type v = [> `A | `B ] is not a subtype of u = [< `A | `B ] |}];; @@ -1146,6 +1202,8 @@ let f6 x = (x : <m:'a. [< `A of < > ] as 'a> :> <m:'a. [< `A of <p:int> ] as 'a>);; [%%expect {| Line _, characters 2-88: + ..(x : <m:'a. (<p:int;..> as 'a) -> int> + :> <m:'b. (<p:int;q:int;..> as 'b) -> int>).. Error: Type < m : 'a. (< p : int; .. > as 'a) -> int > is not a subtype of < m : 'b. (< p : int; q : int; .. > as 'b) -> int > Type < p : int; q : int; .. > as 'c is not a subtype of @@ -1169,14 +1227,20 @@ val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = <fun> |}, Principal{| val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > = <fun> Line _, characters 9-16: + fun x -> (f x)#m;; (* Warning 18 *) + ^^^^^^^ Warning 18: this use of a polymorphic method is not principal. - : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> val f : < m : 'a. 'a -> 'a > * 'b -> < m : 'a. 'a -> 'a > = <fun> Line _, characters 9-20: + fun x -> (f (x,x))#m;; (* Warning 18 *) + ^^^^^^^^^^^ Warning 18: this use of a polymorphic method is not principal. - : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> val f : < m : 'a. 'a -> 'a > -> < m : 'a. 'a -> 'a > array = <fun> Line _, characters 9-20: + fun x -> (f x).(0)#m;; (* Warning 18 *) + ^^^^^^^^^^^ Warning 18: this use of a polymorphic method is not principal. - : < m : 'a. 'a -> 'a > -> 'b -> 'b = <fun> |}];; @@ -1204,9 +1268,13 @@ class c : object method id : 'a -> 'a end type u = c option val just : 'a option -> 'a = <fun> Line _, characters 42-62: + let f x = let l = [Some x; (None : u)] in (just(List.hd l))#id;; + ^^^^^^^^^^^^^^^^^^^^ Warning 18: this use of a polymorphic method is not principal. val f : c -> 'a -> 'a = <fun> Line _, characters 36-47: + let x = List.hd [Some x; none] in (just x)#id;; + ^^^^^^^^^^^ Warning 18: this use of a polymorphic method is not principal. val g : c -> 'a -> 'a = <fun> val h : < id : 'a; .. > -> 'a = <fun> @@ -1248,6 +1316,8 @@ val g : 'a -> int = <fun> type 'a t = Leaf of 'a | Node of ('a * 'a) t val depth : 'a t -> int = <fun> Line _, characters 2-42: + function Leaf _ -> 1 | Node x -> 1 + d x + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This definition has type 'a t -> int which is less general than 'a0. 'a0 t -> int |}];; @@ -1262,6 +1332,8 @@ type t = { f : 'a. [> `B of 'a | `Int of int ] as 'a; } val zero : t = {f = `Int 0} type t = { f : 'a. [< `Int of int ] as 'a; } Line _, characters 16-22: + let zero = {f = `Int 0} ;; (* fails *) + ^^^^^^ Error: This expression has type [> `Int of int ] but an expression was expected of type [< `Int of int ] Types for tag `Int are incompatible @@ -1312,6 +1384,8 @@ let f ?x y = y in {f};; (* fail *) type t = { f : 'a. 'a -> unit; } - : t = {f = <fun>} Line _, characters 19-20: + let f ?x y = y in {f};; (* fail *) + ^ Error: This field value has type unit -> unit which is less general than 'a. 'a -> unit |}];; @@ -1349,6 +1423,8 @@ Exception: Pervasives.Exit. type 'x t = < f : 'y. 'y t >;; [%%expect {| Line _, characters 0-28: + type 'x t = < f : 'y. 'y t >;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: In the definition of t, type 'y t should be 'x t |}];; @@ -1391,6 +1467,8 @@ let (n : < m : 'a. [< `Foo of int] -> 'a >) = object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; [%%expect {| Line _, characters 2-72: + object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type < m : 'x. [< `Foo of 'x ] -> 'x > but an expression was expected of type < m : 'a. [< `Foo of int ] -> 'a > @@ -1401,6 +1479,8 @@ let (n : 'b -> < m : 'a . ([< `Foo of int] as 'b) -> 'a >) = fun x -> object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; [%%expect {| Line _, characters 2-72: + object method m : 'x. [< `Foo of 'x] -> 'x = fun x -> assert false end;; + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: This expression has type < m : 'x. [< `Foo of 'x ] -> 'x > but an expression was expected of type < m : 'a. [< `Foo of int ] -> 'a > @@ -1413,6 +1493,8 @@ let f b (x: 'x) = if b then x else M.A;; [%%expect {| Line _, characters 19-22: + if b then x else M.A;; + ^^^ Error: This expression has type M.t but an expression was expected of type 'x The type constructor M.t would escape its scope |}];; @@ -1505,6 +1587,8 @@ type t = <g> and g = <a:t> [%%expect{| Line _, characters 10-11: + type t = <g> + ^ Error: The type constructor g is not yet completely defined |}] @@ -1514,6 +1598,8 @@ type g = <t> [%%expect{| type t = int Line _, characters 10-11: + type g = <t> + ^ Error: The type int is not an object type |}] @@ -1553,6 +1639,8 @@ type r2 = < a : int > type gg = <a:int->float; a:int> [%%expect{| Line _, characters 27-30: + type gg = <a:int->float; a:int> + ^^^ Error: Method 'a' has type int, which should be int -> float |}] @@ -1561,6 +1649,8 @@ type g = <b:float; t;> [%%expect{| type t = < a : int; b : string > Line _, characters 19-20: + type g = <b:float; t;> + ^ Error: Method 'b' has type string, which should be float |}] @@ -1576,6 +1666,8 @@ type t = < f : int > type t = < int #A.t1 > [%%expect{| Line _, characters 11-20: + type t = < int #A.t1 > + ^^^^^^^^^ Error: Illegal open object type |}] diff --git a/testsuite/tests/typing-sigsubst/sigsubst.ml b/testsuite/tests/typing-sigsubst/sigsubst.ml index 8b51da40f9..379bf546db 100644 --- a/testsuite/tests/typing-sigsubst/sigsubst.ml +++ b/testsuite/tests/typing-sigsubst/sigsubst.ml @@ -23,6 +23,8 @@ module type PrintableComparable = sig end [%%expect {| Line _, characters 2-36: + include Comparable with type t = t + ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ Error: Multiple definition of the type name t. Names must be unique in a given structure or signature. |}] @@ -44,6 +46,10 @@ module type S0 = sig end with type M.t = int [%%expect {| Line _, characters 17-115: + .................sig + module rec M : sig type t = M2.t end + and M2 : sig type t = int end + end with type M.t = int Error: In this `with' constraint, the new definition of M.t does not match its original definition in the constrained signature: Type declarations do not match: @@ -163,6 +169,11 @@ end with type 'a t2 := 'a t * bool [%%expect {| type 'a t constraint 'a = 'b list Line _, characters 16-142: + ................sig + type 'a t2 constraint 'a = 'b list + type 'a mylist = 'a list + val x : int mylist t2 + end with type 'a t2 := 'a t * bool Error: Destructive substitutions are not supported for constrained types (other than when replacing a type constructor with a type constructor with the same arguments). @@ -234,6 +245,10 @@ module type S = sig end with type M.t := float [%%expect {| Line _, characters 16-89: + ................sig + module M : sig type t end + module A = M + end with type M.t := float Error: This `with' constraint on M.t changes M, which is aliased in the constrained signature (as A). |}] @@ -258,6 +273,8 @@ module type S = module type S2 = S with type M.t := float [%%expect {| Line _, characters 17-41: + module type S2 = S with type M.t := float + ^^^^^^^^^^^^^^^^^^^^^^^^ Error: This `with' constraint on M.t makes the applicative functor type F(M).t ill-typed in the constrained signature: Modules do not match: @@ -290,6 +307,10 @@ end with type M2.t := int [%%expect {| module Id : functor (X : sig type t end) -> sig type t = X.t end Line _, characters 17-120: + .................sig + module rec M : sig type t = A of Id(M2).t end + and M2 : sig type t end + end with type M2.t := int Error: This `with' constraint on M2.t makes the applicative functor type Id(M2).t ill-typed in the constrained signature: Modules do not match: sig end is not included in sig type t end @@ -329,6 +350,16 @@ module type S = sig end with module M.N := A [%%expect {| Line _, characters 16-159: + ................sig + module M : sig + module N : sig + module P : sig + type t + end + end + end + module Alias = M + end with module M.N := A Error: This `with' constraint on M.N changes M, which is aliased in the constrained signature (as Alias). |}] diff --git a/testsuite/tools/expect_test.ml b/testsuite/tools/expect_test.ml index 4e259e7653..79f59ba9c1 100644 --- a/testsuite/tools/expect_test.ml +++ b/testsuite/tools/expect_test.ml @@ -132,11 +132,18 @@ let split_chunks phrases = module Compiler_messages = struct let print_loc ppf (loc : Location.t) = let startchar = loc.loc_start.pos_cnum - loc.loc_start.pos_bol in - let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_cnum + startchar in + let endchar = loc.loc_end.pos_cnum - loc.loc_start.pos_bol in Format.fprintf ppf "Line _"; if startchar >= 0 then Format.fprintf ppf ", characters %d-%d" startchar endchar; - Format.fprintf ppf ":@," + Format.fprintf ppf ":@."; + if startchar >= 0 then + begin match !Location.input_lexbuf with + | None -> () + | Some lexbuf -> + Location.show_code_at_location ppf lexbuf loc + end; + () let capture ppf ~f = Misc.protect_refs @@ -182,6 +189,7 @@ let parse_contents ~fname contents = let lexbuf = Lexing.from_string contents in Location.init lexbuf fname; Location.input_name := fname; + Location.input_lexbuf := Some lexbuf; Parse.use_file lexbuf let eval_expectation expectation ~output = |