summaryrefslogtreecommitdiffstats
path: root/testsuite/tests
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/typing-gadts/test.ml.principal.reference2
-rw-r--r--testsuite/tests/typing-gadts/test.ml.reference2
-rw-r--r--testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml31
-rw-r--r--testsuite/tests/typing-modules/a.mli3
-rw-r--r--testsuite/tests/typing-modules/aliases.ml132
-rw-r--r--testsuite/tests/typing-modules/aliases.ml.reference264
-rw-r--r--testsuite/tests/typing-modules/b.ml18
-rw-r--r--testsuite/tests/typing-modules/b2.ml14
-rw-r--r--testsuite/tests/typing-modules/b3.mli4
-rw-r--r--testsuite/tests/typing-modules/d.ml2
-rw-r--r--testsuite/tests/typing-private/private.ml.reference2
-rw-r--r--testsuite/tests/typing-recmod/t19ok.ml7
-rw-r--r--testsuite/tests/typing-short-paths/short-paths.ml.reference47
13 files changed, 477 insertions, 51 deletions
diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference
index 551f9cb2d..0d40f674a 100644
--- a/testsuite/tests/typing-gadts/test.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/test.ml.principal.reference
@@ -311,7 +311,7 @@ Error: This expression has type < bar : int; foo : int; .. > as 'a
# val g : 'a ty -> 'a = <fun>
# module M : sig type _ t = int end
# module M : sig type _ t = T : int t end
-# module N : sig type 'a t = 'a M.t = T : int t end
+# module N = M
# val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = <fun>
# val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = <fun>
#
diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference
index 41b756766..e6aa47b41 100644
--- a/testsuite/tests/typing-gadts/test.ml.reference
+++ b/testsuite/tests/typing-gadts/test.ml.reference
@@ -298,7 +298,7 @@ Error: This expression has type < bar : int; foo : int; .. > as 'a
# val g : 'a ty -> 'a = <fun>
# module M : sig type _ t = int end
# module M : sig type _ t = T : int t end
-# module N : sig type 'a t = 'a M.t = T : int t end
+# module N = M
# val f : ('a, 'b) eq -> ('a, int) eq -> 'a -> 'b -> unit = <fun>
# val f : ('a, 'b) eq -> ('b, int) eq -> 'a -> 'b -> unit = <fun>
#
diff --git a/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml b/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml
new file mode 100644
index 000000000..588744549
--- /dev/null
+++ b/testsuite/tests/typing-modules-bugs/gatien_baron_20131019_ok.ml
@@ -0,0 +1,31 @@
+module Std = struct module Hash = Hashtbl end;;
+
+open Std;;
+module Hash1 : module type of Hash = Hash;;
+module Hash2 : sig include (module type of Hash) end = Hash;;
+let f1 (x : (_,_) Hash1.t) = (x : (_,_) Hashtbl.t);;
+let f2 (x : (_,_) Hash2.t) = (x : (_,_) Hashtbl.t);;
+
+(* Another case, not using include *)
+
+module Std2 = struct module M = struct type t end end;;
+module Std' = Std2;;
+module M' : module type of Std'.M = Std2.M;;
+let f3 (x : M'.t) = (x : Std2.M.t);;
+
+(* original report required Core_kernel:
+module type S = sig
+open Core_kernel.Std
+
+module Hashtbl1 : module type of Hashtbl
+module Hashtbl2 : sig
+ include (module type of Hashtbl)
+end
+
+module Coverage : Core_kernel.Std.Hashable
+
+type types = unit constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl1.t
+type doesnt_type = unit
+ constraint 'a Coverage.Table.t = (Coverage.t, 'a) Hashtbl2.t
+end
+*)
diff --git a/testsuite/tests/typing-modules/a.mli b/testsuite/tests/typing-modules/a.mli
new file mode 100644
index 000000000..ea15bf005
--- /dev/null
+++ b/testsuite/tests/typing-modules/a.mli
@@ -0,0 +1,3 @@
+module L = List
+module S = String
+module D' = D
diff --git a/testsuite/tests/typing-modules/aliases.ml b/testsuite/tests/typing-modules/aliases.ml
new file mode 100644
index 000000000..1c651c4a8
--- /dev/null
+++ b/testsuite/tests/typing-modules/aliases.ml
@@ -0,0 +1,132 @@
+module C = Char;;
+C.chr 66;;
+
+module C' : module type of Char = C;;
+C'.chr 66;;
+
+module C'' : (module C) = C';; (* fails *)
+
+module C'' : (module Char) = C;;
+C''.chr 66;;
+
+module C3 = struct include Char end;;
+C3.chr 66;;
+
+let f x = let module M = struct module L = List end in M.L.length x;;
+let g x = let module L = List in L.length (L.map succ x);;
+
+module F(X:sig end) = Char;;
+module C4 = F(struct end);;
+C4.chr 66;;
+
+module G(X:sig end) = struct module M = X end;; (* does not alias X *)
+module M = G(struct end);;
+
+module M' = struct
+ module N = struct let x = 1 end
+ module N' = N
+end;;
+M'.N'.x;;
+
+module M'' : sig module N' : sig val x : int end end = M';;
+M''.N'.x;;
+module M2 = struct include M' end;;
+module M3 : sig module N' : sig val x : int end end = struct include M' end;;
+M3.N'.x;;
+module M3' : sig module N' : sig val x : int end end = M2;;
+M3'.N'.x;;
+
+module M4 : sig module N' : sig val x : int end end = struct
+ module N = struct let x = 1 end
+ module N' = N
+end;;
+M4.N'.x;;
+
+module F(X:sig end) = struct
+ module N = struct let x = 1 end
+ module N' = N
+end;;
+module G : functor(X:sig end) -> sig module N' : sig val x : int end end = F;;
+module M5 = G(struct end);;
+M5.N'.x;;
+
+module M = struct
+ module D = struct let y = 3 end
+ module N = struct let x = 1 end
+ module N' = N
+end;;
+
+module M1 : sig module N : sig val x : int end module N' = N end = M;;
+M1.N'.x;;
+module M2 : sig module N' : sig val x : int end end =
+ (M : sig module N : sig val x : int end module N' = N end);;
+M2.N'.x;;
+
+open M;;
+N'.x;;
+
+module M = struct
+ module C = Char
+ module C' = C
+end;;
+module M1
+ : sig module C : sig val escaped : char -> string end module C' = C end
+ = M;; (* sound, but should probably fail *)
+M1.C'.escaped 'A';;
+module M2 : sig module C' : sig val chr : int -> char end end =
+ (M : sig module C : sig val chr : int -> char end module C' = C end);;
+M2.C'.chr 66;;
+
+StdLabels.List.map;;
+
+module Q = Queue;;
+exception QE = Q.Empty;;
+try Q.pop (Q.create ()) with QE -> "Ok";;
+
+module type Complex = module type of Complex with type t = Complex.t;;
+module M : sig module C : Complex end = struct module C = Complex end;;
+
+module C = Complex;;
+C.one.Complex.re;;
+include C;;
+
+module F(X:sig module C = Char end) = struct module C = X.C end;;
+
+(* Applicative functors *)
+module S = String
+module StringSet = Set.Make(String)
+module SSet = Set.Make(S);;
+let f (x : StringSet.t) = (x : SSet.t);;
+
+(* Also using include (cf. Leo's mail 2013-11-16) *)
+module F (M : sig end) : sig type t end = struct type t = int end
+module T = struct
+ module M = struct end
+ include F(M)
+end;;
+include T;;
+let f (x : t) : T.t = x ;;
+
+(* PR#4049 *)
+(* This works thanks to abbreviations *)
+module A = struct
+ module B = struct type t let compare x y = 0 end
+ module S = Set.Make(B)
+ let empty = S.empty
+end
+module A1 = A;;
+A1.empty = A.empty;;
+
+(* PR#3476 *)
+(* Does not work yet *)
+module FF(X : sig end) = struct type t end
+module M = struct
+ module X = struct end
+ module Y = FF (X) (* XXX *)
+ type t = Y.t
+end
+module F (Y : sig type t end) (M : sig type t = Y.t end) = struct end;;
+
+module G = F (M.Y);;
+(*module N = G (M);;
+module N = F (M.Y) (M);;*)
diff --git a/testsuite/tests/typing-modules/aliases.ml.reference b/testsuite/tests/typing-modules/aliases.ml.reference
new file mode 100644
index 000000000..723f9ef46
--- /dev/null
+++ b/testsuite/tests/typing-modules/aliases.ml.reference
@@ -0,0 +1,264 @@
+
+# module C = Char
+# - : char = 'B'
+# module C' :
+ sig
+ external code : char -> int = "%identity"
+ val chr : int -> char
+ val escaped : char -> string
+ val lowercase : char -> char
+ val uppercase : char -> char
+ type t = char
+ val compare : t -> t -> int
+ external unsafe_chr : int -> char = "%identity"
+ end
+# - : char = 'B'
+# Characters 27-29:
+ module C'' : (module C) = C';; (* fails *)
+ ^^
+Error: Signature mismatch:
+ Modules do not match: (module C') is not included in (module C)
+# module C'' = Char
+# - : char = 'B'
+# module C3 :
+ sig
+ external code : char -> int = "%identity"
+ val chr : int -> char
+ val escaped : char -> string
+ val lowercase : char -> char
+ val uppercase : char -> char
+ type t = char
+ val compare : t -> t -> int
+ external unsafe_chr : int -> char = "%identity"
+ end
+# - : char = 'B'
+# val f : 'a list -> int = <fun>
+# val g : int list -> int = <fun>
+# module F :
+ functor (X : sig end) ->
+ sig
+ external code : char -> int = "%identity"
+ val chr : int -> char
+ val escaped : char -> string
+ val lowercase : char -> char
+ val uppercase : char -> char
+ type t = char
+ val compare : t -> t -> int
+ external unsafe_chr : int -> char = "%identity"
+ end
+# module C4 :
+ sig
+ external code : char -> int = "%identity"
+ val chr : int -> char
+ val escaped : char -> string
+ val lowercase : char -> char
+ val uppercase : char -> char
+ type t = char
+ val compare : t -> t -> int
+ external unsafe_chr : int -> char = "%identity"
+ end
+# - : char = 'B'
+# module G : functor (X : sig end) -> sig module M : sig end end
+# module M : sig module M : sig end end
+# module M' : sig module N : sig val x : int end module N' = N end
+# - : int = 1
+# module M'' : sig module N' : sig val x : int end end
+# - : int = 1
+# module M2 : sig module N = M'.N module N' = M'.N' end
+# module M3 : sig module N' : sig val x : int end end
+# - : int = 1
+# module M3' : sig module N' : sig val x : int end end
+# - : int = 1
+# module M4 : sig module N' : sig val x : int end end
+# - : int = 1
+# module F :
+ functor (X : sig end) ->
+ sig module N : sig val x : int end module N' = N end
+# module G : functor (X : sig end) -> sig module N' : sig val x : int end end
+# module M5 : sig module N' : sig val x : int end end
+# - : int = 1
+# module M :
+ sig
+ module D : sig val y : int end
+ module N : sig val x : int end
+ module N' = N
+ end
+# module M1 : sig module N : sig val x : int end module N' = N end
+# - : int = 1
+# module M2 : sig module N' : sig val x : int end end
+# - : int = 1
+# # - : int = 1
+# module M : sig module C = Char module C' = C end
+# module M1 :
+ sig module C : sig val escaped : char -> string end module C' = C end
+# - : string = "A"
+# module M2 : sig module C' : sig val chr : int -> char end end
+# - : char = 'B'
+# - : f:('a -> 'b) -> 'a list -> 'b list = <fun>
+# module Q = Queue
+# exception QE
+# - : string = "Ok"
+# module type Complex =
+ sig
+ type t = Complex.t = { re : float; im : float; }
+ val zero : t
+ val one : t
+ val i : t
+ val neg : t -> t
+ val conj : t -> t
+ val add : t -> t -> t
+ val sub : t -> t -> t
+ val mul : t -> t -> t
+ val inv : t -> t
+ val div : t -> t -> t
+ val sqrt : t -> t
+ val norm2 : t -> float
+ val norm : t -> float
+ val arg : t -> float
+ val polar : float -> float -> t
+ val exp : t -> t
+ val log : t -> t
+ val pow : t -> t -> t
+ end
+# module M : sig module C : Complex end
+# module C = Complex
+# - : float = 1.
+# type t = Complex.t = { re : float; im : float; }
+val zero : t = {re = 0.; im = 0.}
+val one : t = {re = 1.; im = 0.}
+val i : t = {re = 0.; im = 1.}
+val neg : t -> t = <fun>
+val conj : t -> t = <fun>
+val add : t -> t -> t = <fun>
+val sub : t -> t -> t = <fun>
+val mul : t -> t -> t = <fun>
+val inv : t -> t = <fun>
+val div : t -> t -> t = <fun>
+val sqrt : t -> t = <fun>
+val norm2 : t -> float = <fun>
+val norm : t -> float = <fun>
+val arg : t -> float = <fun>
+val polar : float -> float -> t = <fun>
+val exp : t -> t = <fun>
+val log : t -> t = <fun>
+val pow : t -> t -> t = <fun>
+# module F : functor (X : sig module C = Char end) -> sig module C = Char end
+# module S = String
+module StringSet :
+ sig
+ type elt = String.t
+ type t = Set.Make(String).t
+ val empty : t
+ val is_empty : t -> bool
+ val mem : elt -> t -> bool
+ val add : elt -> t -> t
+ val singleton : elt -> t
+ val remove : elt -> t -> t
+ val union : t -> t -> t
+ val inter : t -> t -> t
+ val diff : t -> t -> t
+ val compare : t -> t -> int
+ val equal : t -> t -> bool
+ val subset : t -> t -> bool
+ val iter : (elt -> unit) -> t -> unit
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ val for_all : (elt -> bool) -> t -> bool
+ val exists : (elt -> bool) -> t -> bool
+ val filter : (elt -> bool) -> t -> t
+ val partition : (elt -> bool) -> t -> t * t
+ val cardinal : t -> int
+ val elements : t -> elt list
+ val min_elt : t -> elt
+ val max_elt : t -> elt
+ val choose : t -> elt
+ val split : elt -> t -> t * bool * t
+ val find : elt -> t -> elt
+ val of_list : elt list -> t
+ end
+module SSet :
+ sig
+ type elt = S.t
+ type t = Set.Make(S).t
+ val empty : t
+ val is_empty : t -> bool
+ val mem : elt -> t -> bool
+ val add : elt -> t -> t
+ val singleton : elt -> t
+ val remove : elt -> t -> t
+ val union : t -> t -> t
+ val inter : t -> t -> t
+ val diff : t -> t -> t
+ val compare : t -> t -> int
+ val equal : t -> t -> bool
+ val subset : t -> t -> bool
+ val iter : (elt -> unit) -> t -> unit
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ val for_all : (elt -> bool) -> t -> bool
+ val exists : (elt -> bool) -> t -> bool
+ val filter : (elt -> bool) -> t -> t
+ val partition : (elt -> bool) -> t -> t * t
+ val cardinal : t -> int
+ val elements : t -> elt list
+ val min_elt : t -> elt
+ val max_elt : t -> elt
+ val choose : t -> elt
+ val split : elt -> t -> t * bool * t
+ val find : elt -> t -> elt
+ val of_list : elt list -> t
+ end
+# val f : StringSet.t -> SSet.t = <fun>
+# module F : functor (M : sig end) -> sig type t end
+module T : sig module M : sig end type t = F(M).t end
+# module M = T.M
+type t = F(M).t
+# val f : t -> T.t = <fun>
+# module A :
+ sig
+ module B : sig type t val compare : 'a -> 'b -> int end
+ module S :
+ sig
+ type elt = B.t
+ type t = Set.Make(B).t
+ val empty : t
+ val is_empty : t -> bool
+ val mem : elt -> t -> bool
+ val add : elt -> t -> t
+ val singleton : elt -> t
+ val remove : elt -> t -> t
+ val union : t -> t -> t
+ val inter : t -> t -> t
+ val diff : t -> t -> t
+ val compare : t -> t -> int
+ val equal : t -> t -> bool
+ val subset : t -> t -> bool
+ val iter : (elt -> unit) -> t -> unit
+ val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
+ val for_all : (elt -> bool) -> t -> bool
+ val exists : (elt -> bool) -> t -> bool
+ val filter : (elt -> bool) -> t -> t
+ val partition : (elt -> bool) -> t -> t * t
+ val cardinal : t -> int
+ val elements : t -> elt list
+ val min_elt : t -> elt
+ val max_elt : t -> elt
+ val choose : t -> elt
+ val split : elt -> t -> t * bool * t
+ val find : elt -> t -> elt
+ val of_list : elt list -> t
+ end
+ val empty : S.t
+ end
+module A1 = A
+# - : bool = true
+# module FF : functor (X : sig end) -> sig type t end
+module M :
+ sig
+ module X : sig end
+ module Y : sig type t = FF(X).t end
+ type t = Y.t
+ end
+module F :
+ functor (Y : sig type t end) ->
+ functor (M : sig type t = Y.t end) -> sig end
+# module G : functor (M : sig type t = M.Y.t end) -> sig end
+# *
diff --git a/testsuite/tests/typing-modules/b.ml b/testsuite/tests/typing-modules/b.ml
new file mode 100644
index 000000000..4c43e809f
--- /dev/null
+++ b/testsuite/tests/typing-modules/b.ml
@@ -0,0 +1,18 @@
+open A
+let f =
+ L.map S.capitalize
+
+let () =
+ L.iter print_endline (f ["jacques"; "garrigue"])
+
+module C : sig module L : module type of List end = struct include A end
+
+(* The following introduces a (useless) dependency on A:
+module C : sig module L : module type of List end = A
+*)
+
+include D'
+(*
+let () =
+ print_endline (string_of_int D'.M.y)
+*)
diff --git a/testsuite/tests/typing-modules/b2.ml b/testsuite/tests/typing-modules/b2.ml
new file mode 100644
index 000000000..034e432c3
--- /dev/null
+++ b/testsuite/tests/typing-modules/b2.ml
@@ -0,0 +1,14 @@
+open A
+let f =
+ L.map S.capitalize
+
+let () =
+ L.iter print_endline (f ["jacques"; "garrigue"])
+
+module C : sig module L : module type of List end = struct include A end
+
+(* The following introduces a (useless) dependency on A:
+module C : sig module L : module type of List end = A
+*)
+
+(* No dependency on D *)
diff --git a/testsuite/tests/typing-modules/b3.mli b/testsuite/tests/typing-modules/b3.mli
new file mode 100644
index 000000000..04599abe3
--- /dev/null
+++ b/testsuite/tests/typing-modules/b3.mli
@@ -0,0 +1,4 @@
+open A
+(*module type S = module type of D'.M*)
+type t = Complex.t
+type s = String.t
diff --git a/testsuite/tests/typing-modules/d.ml b/testsuite/tests/typing-modules/d.ml
new file mode 100644
index 000000000..55d311f40
--- /dev/null
+++ b/testsuite/tests/typing-modules/d.ml
@@ -0,0 +1,2 @@
+let x = 3
+module M = struct let y = 5 end
diff --git a/testsuite/tests/typing-private/private.ml.reference b/testsuite/tests/typing-private/private.ml.reference
index 3d217802b..d21ec4a14 100644
--- a/testsuite/tests/typing-private/private.ml.reference
+++ b/testsuite/tests/typing-private/private.ml.reference
@@ -6,7 +6,7 @@
^
Error: This expression has type F0.t but an expression was expected of type
Foobar.t
-# module F : sig type t = Foobar.t end
+# module F = Foobar
# val f : F.t -> Foobar.t = <fun>
# module M : sig type t = < m : int > end
# module M1 : sig type t = private < m : int; .. > end
diff --git a/testsuite/tests/typing-recmod/t19ok.ml b/testsuite/tests/typing-recmod/t19ok.ml
index 62e5f4548..e51fa5c92 100644
--- a/testsuite/tests/typing-recmod/t19ok.ml
+++ b/testsuite/tests/typing-recmod/t19ok.ml
@@ -5,8 +5,11 @@ module PR_4758 = struct
module type Mod = sig
module Other : S
end
- module rec A : S = struct
- end and C : sig include Mod with module Other = A end = struct
+ module rec A : S = struct end
+ and C : sig include Mod with module Other = A end = struct
module Other = A
end
+ module C' = C (* check that we can take an alias *)
+ module F(X:sig end) = struct type t end
+ let f (x : F(C).t) = (x : F(C').t)
end
diff --git a/testsuite/tests/typing-short-paths/short-paths.ml.reference b/testsuite/tests/typing-short-paths/short-paths.ml.reference
index 4c1a991a5..657a52145 100644
--- a/testsuite/tests/typing-short-paths/short-paths.ml.reference
+++ b/testsuite/tests/typing-short-paths/short-paths.ml.reference
@@ -44,52 +44,7 @@
val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
end
end
- module Std :
- sig
- module Int :
- sig
- module T :
- sig
- type t = int
- val compare : 'a -> 'a -> t
- val ( + ) : t -> t -> t
- end
- type t = int
- val compare : 'a -> 'a -> t
- val ( + ) : t -> t -> t
- module Map :
- sig
- type key = t
- type 'a t = 'a Map.Make(T).t
- val empty : 'a t
- val is_empty : 'a t -> bool
- val mem : key -> 'a t -> bool
- val add : key -> 'a -> 'a t -> 'a t
- val singleton : key -> 'a -> 'a t
- val remove : key -> 'a t -> 'a t
- val merge :
- (key -> 'a option -> 'b option -> 'c option) ->
- 'a t -> 'b t -> 'c t
- val compare : ('a -> 'a -> key) -> 'a t -> 'a t -> key
- val equal : ('a -> 'a -> bool) -> 'a t -> 'a t -> bool
- val iter : (key -> 'a -> unit) -> 'a t -> unit
- val fold : (key -> 'a -> 'b -> 'b) -> 'a t -> 'b -> 'b
- val for_all : (key -> 'a -> bool) -> 'a t -> bool
- val exists : (key -> 'a -> bool) -> 'a t -> bool
- val filter : (key -> 'a -> bool) -> 'a t -> 'a t
- val partition : (key -> 'a -> bool) -> 'a t -> 'a t * 'a t
- val cardinal : 'a t -> key
- val bindings : 'a t -> (key * 'a) list
- val min_binding : 'a t -> key * 'a
- val max_binding : 'a t -> key * 'a
- val choose : 'a t -> key * 'a
- val split : key -> 'a t -> 'a t * 'a option * 'a t
- val find : key -> 'a t -> 'a
- val map : ('a -> 'b) -> 'a t -> 'b t
- val mapi : (key -> 'a -> 'b) -> 'a t -> 'b t
- end
- end
- end
+ module Std : sig module Int = Int end
end
# # val x : 'a Int.Map.t = <abstr>
# Characters 8-9:
generated by cgit v1.2.3-70-g09d2 (git 2.46.0) at 2025-04-09 20:20:16 +0000