Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

expect-style tests: include the code at the location of error messages 

(joint work with Armaël Guéneau)
master
Gabriel Scherer 2017-12-03 19:29:10 +00:00
parent 51b44285d9
commit 91dff3230a
67 changed files with 620 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
testsuite/tests/messages/precise_locations.ml
View File

@ -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
|}];;

2
testsuite/tests/typing-core-bugs/example_let_missing_rec.ml
View File

@ -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.
|}]

2
testsuite/tests/typing-core-bugs/example_let_missing_rec_loc.ml
View File

@ -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.
|}];;

2
testsuite/tests/typing-core-bugs/example_let_missing_rec_mutual.ml
View File

@ -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.
|}]

10
testsuite/tests/typing-core-bugs/unit_fun_hints.ml
View File

@ -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?

72
testsuite/tests/typing-deprecated/deprecated.ml
View File

@ -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:
_::_

10
testsuite/tests/typing-gadts/didier.ml
View File

@ -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

2
testsuite/tests/typing-gadts/dynamic_frisch.ml
View File

@ -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

4
testsuite/tests/typing-gadts/nested_equations.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr5332.ml
View File

@ -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)
|}];;

2
testsuite/tests/typing-gadts/pr5689.ml
View File

@ -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

3
testsuite/tests/typing-gadts/pr5785.ml
View File

@ -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)

2
testsuite/tests/typing-gadts/pr5848.ml
View File

@ -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.
|}];;

5
testsuite/tests/typing-gadts/pr5906.ml
View File

@ -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 _, _)

4
testsuite/tests/typing-gadts/pr5948.ml
View File

@ -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
|}];;

4
testsuite/tests/typing-gadts/pr5981.ml
View File

@ -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)

22
testsuite/tests/typing-gadts/pr5985.ml
View File

@ -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.
|}];;

4
testsuite/tests/typing-gadts/pr5989.ml
View File

@ -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

4
testsuite/tests/typing-gadts/pr5997.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr6158.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr6163.ml
View File

@ -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))))

2
testsuite/tests/typing-gadts/pr6174.ml
View File

@ -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
|}];;

2
testsuite/tests/typing-gadts/pr6241.ml
View File

@ -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

8
testsuite/tests/typing-gadts/pr6690.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr6934.ml
View File

@ -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.
|}]

2
testsuite/tests/typing-gadts/pr6980.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr6993_bad.ml
View File

@ -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

4
testsuite/tests/typing-gadts/pr7016.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr7160.ml
View File

@ -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.
|}];;

4
testsuite/tests/typing-gadts/pr7214.ml
View File

@ -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

4
testsuite/tests/typing-gadts/pr7222.ml
View File

@ -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

4
testsuite/tests/typing-gadts/pr7234.ml
View File

@ -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

6
testsuite/tests/typing-gadts/pr7260.ml
View File

@ -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
|}];;

6
testsuite/tests/typing-gadts/pr7269.ml
View File

@ -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 _

4
testsuite/tests/typing-gadts/pr7374.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr7378.ml
View File

@ -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.
|}]

2
testsuite/tests/typing-gadts/pr7390.ml
View File

@ -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 _)

2
testsuite/tests/typing-gadts/pr7391.ml
View File

@ -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

4
testsuite/tests/typing-gadts/pr7421.ml
View File

@ -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

2
testsuite/tests/typing-gadts/pr7432.ml
View File

@ -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

13
testsuite/tests/typing-gadts/pr7518.ml
View File

@ -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

85
testsuite/tests/typing-gadts/test.ml
View File

@ -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

10
testsuite/tests/typing-gadts/yallop_bugs.ml
View File

@ -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}

11
testsuite/tests/typing-immediate/immediate.ml
View File

@ -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
|}];;

20
testsuite/tests/typing-misc/constraints.ml
View File

@ -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 _

4
testsuite/tests/typing-misc/labels.ml
View File

@ -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
|}];;

4
testsuite/tests/typing-misc/occur_check.ml
View File

@ -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

16
testsuite/tests/typing-misc/polyvars.ml
View File

@ -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?
|}]

6
testsuite/tests/typing-misc/pr6939-flat-float-array.ml
View File

@ -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'
|}];;

4
testsuite/tests/typing-misc/pr6939-no-flat-float-array.ml
View File

@ -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.

6
testsuite/tests/typing-misc/pr7103.ml
View File

@ -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

2
testsuite/tests/typing-misc/pr7228.ml
View File

@ -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
|}];;

2
testsuite/tests/typing-misc/pr7668_bad.ml
View File

@ -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

2
testsuite/tests/typing-misc/printing.ml
View File

@ -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?
|}];;

22
testsuite/tests/typing-misc/records.ml
View File

@ -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
|}];;

4
testsuite/tests/typing-misc/variant.ml
View File

@ -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

2
testsuite/tests/typing-misc/wellfounded.ml
View File

@ -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
|}];;

8
testsuite/tests/typing-modules/Test.ml
View File

@ -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
|}];;

2
testsuite/tests/typing-modules/aliases.ml
View File

@ -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)

4
testsuite/tests/typing-modules/firstclass.ml
View File

@ -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')
|}];;

8
testsuite/tests/typing-modules/generative.ml
View File

@ -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

4
testsuite/tests/typing-modules/pr6394.ml
View File

@ -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

2
testsuite/tests/typing-modules/pr7207.ml
View File

@ -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
|}];;

2
testsuite/tests/typing-modules/recursive.ml
View File

@ -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
|}]

92
testsuite/tests/typing-poly/poly.ml
View File

@ -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
|}]

31
testsuite/tests/typing-sigsubst/sigsubst.ml
View File

@ -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).
|}]

12
testsuite/tools/expect_test.ml
View File

@ -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 =