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

testsuite: switch typing-objects from toplevel to expect tests

master
Thomas Refis 2018-02-16 13:30:09 +00:00 committed by Thomas Refis
parent d78eecd0ef
commit 42ff6e44b2
25 changed files with 1212 additions and 1465 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

359
testsuite/tests/typing-objects/Exemples.compilers.reference
View File

@ -1,359 +0,0 @@
class point :
int ->
object val mutable x : int method get_x : int method move : int -> unit end
val p : point = <obj>
- : int = 7
- : unit = ()
- : int = 10
val q : point = <obj>
- : int * int = (10, 17)
class color_point :
int ->
string ->
object
val c : string
val mutable x : int
method color : string
method get_x : int
method move : int -> unit
end
val p' : color_point = <obj>
- : int * string = (5, "red")
val l : point list = [<obj>; <obj>]
val get_x : < get_x : 'a; .. > -> 'a = <fun>
val set_x : < set_x : 'a; .. > -> 'a = <fun>
- : int list = [10; 5]
Characters 1-96:
class ref x_init = object
val mutable x = x_init
method get = x
method set y = x <- y
end..
Error: Some type variables are unbound in this type:
class ref :
'a ->
object
val mutable x : 'a
method get : 'a
method set : 'a -> unit
end
The method get has type 'a where 'a is unbound
class ref :
int ->
object val mutable x : int method get : int method set : int -> unit end
class ['a] ref :
'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end
- : int = 2
class ['a] circle :
'a ->
object
constraint 'a = < move : int -> unit; .. >
val mutable center : 'a
method center : 'a
method move : int -> unit
method set_center : 'a -> unit
end
class ['a] circle :
'a ->
object
constraint 'a = #point
val mutable center : 'a
method center : 'a
method move : int -> unit
method set_center : 'a -> unit
end
val c : point circle = <obj>
val c' : color_point circle = <obj>
class ['a] color_circle :
'a ->
object
constraint 'a = #color_point
val mutable center : 'a
method center : 'a
method color : string
method move : int -> unit
method set_center : 'a -> unit
end
Characters 28-29:
let c'' = new color_circle p;;
^
Error: This expression has type point but an expression was expected of type
#color_point
The first object type has no method color
val c'' : color_point color_circle = <obj>
- : color_point circle = <obj>
Characters 0-21:
(c'' :> point circle);; (* Fail *)
^^^^^^^^^^^^^^^^^^^^^
Error: Type
color_point color_circle =
< center : color_point; color : string; move : int -> unit;
set_center : color_point -> unit >
is not a subtype of
point circle =
< center : point; move : int -> unit; set_center : point -> unit >
Type point is not a subtype of color_point
Characters 9-55:
fun x -> (x : color_point color_circle :> point circle);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type
color_point color_circle =
< center : color_point; color : string; move : int -> unit;
set_center : color_point -> unit >
is not a subtype of
point circle =
< center : point; move : int -> unit; set_center : point -> unit >
Type point is not a subtype of color_point
class printable_point :
int ->
object
val mutable x : int
method get_x : int
method move : int -> unit
method print : unit
end
val p : printable_point = <obj>
7- : unit = ()
Characters 85-102:
inherit printable_point y as super
^^^^^^^^^^^^^^^^^
Warning 13: the following instance variables are overridden by the class printable_point :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class printable_color_point :
int ->
string ->
object
val c : string
val mutable x : int
method color : string
method get_x : int
method move : int -> unit
method print : unit
end
val p' : printable_color_point = <obj>
(7, red)- : unit = ()
class functional_point :
int ->
object ('a) val x : int method get_x : int method move : int -> 'a end
val p : functional_point = <obj>
- : int = 7
- : int = 10
- : int = 7
- : #functional_point -> functional_point = <fun>
class virtual ['a] lst :
unit ->
object
method virtual hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method virtual null : bool
method print : ('a -> unit) -> unit
method virtual tl : 'a lst
end
and ['a] nil :
unit ->
object
method hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method null : bool
method print : ('a -> unit) -> unit
method tl : 'a lst
end
and ['a] cons :
'a ->
'a lst ->
object
val h : 'a
val t : 'a lst
method hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method null : bool
method print : ('a -> unit) -> unit
method tl : 'a lst
end
val l1 : int lst = <obj>
(3::10::[])- : unit = ()
val l2 : int lst = <obj>
(4::11::[])- : unit = ()
val map_list : ('a -> 'b) -> 'a lst -> 'b lst = <fun>
val p1 : printable_color_point lst = <obj>
((3, red)::(10, red)::[])- : unit = ()
class virtual comparable :
unit -> object ('a) method virtual cmp : 'a -> int end
class int_comparable :
int -> object ('a) val x : int method cmp : 'a -> int method x : int end
class int_comparable2 :
int ->
object ('a)
val x : int
val mutable x' : int
method cmp : 'a -> int
method set_x : int -> unit
method x : int
end
class ['a] sorted_list :
unit ->
object
constraint 'a = #comparable
val mutable l : 'a list
method add : 'a -> unit
method hd : 'a
end
val l : _#comparable sorted_list = <obj>
val c : int_comparable = <obj>
- : unit = ()
val c2 : int_comparable2 = <obj>
Characters 6-28:
l#add (c2 :> int_comparable);; (* Fail : 'a comp2 is not a subtype *)
^^^^^^^^^^^^^^^^^^^^^^
Error: Type
int_comparable2 =
< cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
is not a subtype of
int_comparable = < cmp : int_comparable -> int; x : int >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not a subtype of
int_comparable2 =
< cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
- : unit = ()
class int_comparable3 :
int ->
object
val mutable x : int
method cmp : int_comparable -> int
method setx : int -> unit
method x : int
end
val c3 : int_comparable3 = <obj>
- : unit = ()
Characters 25-27:
(new sorted_list ())#add c3;; (* Error; strange message with -principal *)
^^
Error: This expression has type
int_comparable3 =
< cmp : int_comparable -> int; setx : int -> unit; x : int >
but an expression was expected of type
#comparable as 'a = < cmp : 'a -> int; .. >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not compatible with type
int_comparable3 =
< cmp : int_comparable -> int; setx : int -> unit; x : int >
The first object type has no method setx
val sort : (#comparable as 'a) list -> 'a list = <fun>
Characters 13-66:
List.map (fun c -> print_int c#x; print_string " ") l;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10: this expression should have type unit.
val pr : < x : int; .. > list -> unit = <fun>
val l : int_comparable list = [<obj>; <obj>; <obj>]
5 2 4
- : unit = ()
2 4 5
- : unit = ()
val l : int_comparable2 list = [<obj>; <obj>]
2 0
- : unit = ()
0 2
- : unit = ()
val min : (#comparable as 'a) -> 'a -> 'a = <fun>
- : int = 7
- : int = 3
class ['a] link :
'a ->
object ('b)
val mutable next : 'b option
val mutable x : 'a
method append : 'b option -> unit
method next : 'b option
method set_next : 'b option -> unit
method set_x : 'a -> unit
method x : 'a
end
class ['a] double_link :
'a ->
object ('b)
val mutable next : 'b option
val mutable prev : 'b option
val mutable x : 'a
method append : 'b option -> unit
method next : 'b option
method prev : 'b option
method set_next : 'b option -> unit
method set_prev : 'b option -> unit
method set_x : 'a -> unit
method x : 'a
end
val fold_right : ('a -> 'b -> 'b) -> 'a #link option -> 'b -> 'b = <fun>
class calculator :
unit ->
object ('a)
val mutable acc : float
val mutable arg : float
val mutable equals : 'a -> float
method acc : float
method add : 'a
method arg : float
method enter : float -> 'a
method equals : float
method sub : 'a
end
- : float = 5.
- : float = 1.5
- : float = 15.
class calculator :
unit ->
object ('a)
val mutable acc : float
val mutable arg : float
val mutable equals : 'a -> float
method acc : float
method add : 'a
method arg : float
method enter : float -> 'a
method equals : float
method sub : 'a
end
- : float = 5.
- : float = 1.5
- : float = 15.
class calculator :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
and calculator_add :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
and calculator_sub :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
val calculator : calculator = <obj>
- : float = 5.
- : float = 1.5
- : float = 15.

585
testsuite/tests/typing-objects/Exemples.ml
View File

@ -1,5 +1,5 @@
(* TEST
* toplevel
* expect
*)
class point x_init = object
@ -7,52 +7,136 @@ class point x_init = object
method get_x = x
method move d = x <- x + d
end;;
[%%expect{|
class point :
int ->
object val mutable x : int method get_x : int method move : int -> unit end
|}];;
let p = new point 7;;
[%%expect{|
val p : point = <obj>
|}];;
p#get_x;;
[%%expect{|
- : int = 7
|}];;
p#move 3;;
[%%expect{|
- : unit = ()
|}];;
p#get_x;;
[%%expect{|
- : int = 10
|}];;
let q = Oo.copy p;;
[%%expect{|
val q : point = <obj>
|}, Principal{|
val q : < get_x : int; move : int -> unit > = <obj>
|}];;
q#move 7; p#get_x, q#get_x;;
[%%expect{|
- : int * int = (10, 17)
|}];;
class color_point x (c : string) = object
inherit point x
val c = c
method color = c
end;;
[%%expect{|
class color_point :
int ->
string ->
object
val c : string
val mutable x : int
method color : string
method get_x : int
method move : int -> unit
end
|}];;
let p' = new color_point 5 "red";;
[%%expect{|
val p' : color_point = <obj>
|}];;
p'#get_x, p'#color;;
[%%expect{|
- : int * string = (5, "red")
|}];;
let l = [p; (p' :> point)];;
[%%expect{|
val l : point list = [<obj>; <obj>]
|}];;
let get_x p = p#get_x;;
[%%expect{|
val get_x : < get_x : 'a; .. > -> 'a = <fun>
|}];;
let set_x p = p#set_x;;
[%%expect{|
val set_x : < set_x : 'a; .. > -> 'a = <fun>
|}];;
List.map get_x l;;
[%%expect{|
- : int list = [10; 5]
|}];;
class ref x_init = object
val mutable x = x_init
method get = x
method set y = x <- y
end;;
[%%expect{|
Line _, characters 0-95:
class ref x_init = object
val mutable x = x_init
method get = x
method set y = x <- y
end..
Error: Some type variables are unbound in this type:
class ref :
'a ->
object
val mutable x : 'a
method get : 'a
method set : 'a -> unit
end
The method get has type 'a where 'a is unbound
|}];;
class ref (x_init:int) = object
val mutable x = x_init
method get = x
method set y = x <- y
end;;
[%%expect{|
class ref :
int ->
object val mutable x : int method get : int method set : int -> unit end
|}];;
class ['a] ref x_init = object
val mutable x = (x_init : 'a)
method get = x
method set y = x <- y
end;;
[%%expect{|
class ['a] ref :
'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end
|}];;
let r = new ref 1 in r#set 2; (r#get);;
[%%expect{|
- : int = 2
|}];;
class ['a] circle (c : 'a) = object
val mutable center = c
@ -60,6 +144,17 @@ class ['a] circle (c : 'a) = object
method set_center c = center <- c
method move = (center#move : int -> unit)
end;;
[%%expect{|
class ['a] circle :
'a ->
object
constraint 'a = < move : int -> unit; .. >
val mutable center : 'a
method center : 'a
method move : int -> unit
method set_center : 'a -> unit
end
|}];;
class ['a] circle (c : 'a) = object
constraint 'a = #point
@ -68,57 +163,188 @@ class ['a] circle (c : 'a) = object
method set_center c = center <- c
method move = center#move
end;;
[%%expect{|
class ['a] circle :
'a ->
object
constraint 'a = #point
val mutable center : 'a
method center : 'a
method move : int -> unit
method set_center : 'a -> unit
end
|}];;
let (c, c') = (new circle p, new circle p');;
[%%expect{|
val c : point circle = <obj>
val c' : color_point circle = <obj>
|}, Principal{|
val c : point circle = <obj>
val c' : < color : string; get_x : int; move : int -> unit > circle = <obj>
|}];;
class ['a] color_circle c = object
constraint 'a = #color_point
inherit ['a] circle c
method color = center#color
end;;
[%%expect{|
class ['a] color_circle :
'a ->
object
constraint 'a = #color_point
val mutable center : 'a
method center : 'a
method color : string
method move : int -> unit
method set_center : 'a -> unit
end
|}];;
let c'' = new color_circle p;;
[%%expect{|
Line _, characters 27-28:
let c'' = new color_circle p;;
^
Error: This expression has type point but an expression was expected of type
#color_point
The first object type has no method color
|}];;
let c'' = new color_circle p';;
[%%expect{|
val c'' : color_point color_circle = <obj>
|}];;
(c'' :> color_point circle);;
(c'' :> point circle);; (* Fail *)
[%%expect{|
- : color_point circle = <obj>
|}];;
(c'' :> point circle);;
[%%expect{|
Line _, characters 0-21:
(c'' :> point circle);;
^^^^^^^^^^^^^^^^^^^^^
Error: Type
color_point color_circle =
< center : color_point; color : string; move : int -> unit;
set_center : color_point -> unit >
is not a subtype of
point circle =
< center : point; move : int -> unit; set_center : point -> unit >
Type point is not a subtype of color_point
|}];; (* Fail *)
fun x -> (x : color_point color_circle :> point circle);;
[%%expect{|
Line _, characters 9-55:
fun x -> (x : color_point color_circle :> point circle);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type
color_point color_circle =
< center : color_point; color : string; move : int -> unit;
set_center : color_point -> unit >
is not a subtype of
point circle =
< center : point; move : int -> unit; set_center : point -> unit >
Type point is not a subtype of color_point
|}];;
class printable_point y = object (s)
inherit point y
method print = print_int s#get_x
method print = Format.print_int s#get_x
end;;
[%%expect{|
class printable_point :
int ->
object
val mutable x : int
method get_x : int
method move : int -> unit
method print : unit
end
|}];;
let p = new printable_point 7;;
[%%expect{|
val p : printable_point = <obj>
|}];;
p#print;;
[%%expect{|
- : unit = ()
|}];;
class printable_color_point y c = object (self)
inherit color_point y c
inherit printable_point y as super
method print =
print_string "(";
Format.print_string "(";
super#print;
print_string ", ";
print_string (self#color);
print_string ")"
Format.print_string ", ";
Format.print_string (self#color);
Format.print_string ")"
end;;
[%%expect{|
Line _, characters 10-27:
inherit printable_point y as super
^^^^^^^^^^^^^^^^^
Warning 13: the following instance variables are overridden by the class printable_point :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class printable_color_point :
int ->
string ->
object
val c : string
val mutable x : int
method color : string
method get_x : int
method move : int -> unit
method print : unit
end
|}];;
let p' = new printable_color_point 7 "red";;
[%%expect{|
val p' : printable_color_point = <obj>
|}];;
p'#print;;
[%%expect{|
- : unit = ()
|}];;
class functional_point y = object
val x = y
method get_x = x
method move d = {< x = x + d >}
end;;
[%%expect{|
class functional_point :
int ->
object ('a) val x : int method get_x : int method move : int -> 'a end
|}];;
let p = new functional_point 7;;
[%%expect{|
val p : functional_point = <obj>
|}];;
p#get_x;;
[%%expect{|
- : int = 7
|}];;
(p#move 3)#get_x;;
[%%expect{|
- : int = 10
|}];;
p#get_x;;
[%%expect{|
- : int = 7
|}];;
fun x -> (x :> functional_point);;
[%%expect{|
- : #functional_point -> functional_point = <fun>
|}];;
(*******************************************************************)
@ -139,10 +365,10 @@ class virtual ['a] lst () = object (self)
self#tl#iter f
end
method print (f : 'a -> unit) =
print_string "(";
self#iter (fun x -> f x; print_string "::");
print_string "[]";
print_string ")"
Format.print_string "(";
self#iter (fun x -> f x; Format.print_string "::");
Format.print_string "[]";
Format.print_string ")"
end and ['a] nil () = object
inherit ['a] lst ()
method null = true
@ -155,26 +381,86 @@ end and ['a] cons h t = object
method hd = h
method tl = t
end;;
[%%expect{|
class virtual ['a] lst :
unit ->
object
method virtual hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method virtual null : bool
method print : ('a -> unit) -> unit
method virtual tl : 'a lst
end
and ['a] nil :
unit ->
object
method hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method null : bool
method print : ('a -> unit) -> unit
method tl : 'a lst
end
and ['a] cons :
'a ->
'a lst ->
object
val h : 'a
val t : 'a lst
method hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method null : bool
method print : ('a -> unit) -> unit
method tl : 'a lst
end
|}];;
let l1 = new cons 3 (new cons 10 (new nil ()));;
[%%expect{|
val l1 : int lst = <obj>
|}];;
l1#print print_int;;
l1#print Format.print_int;;
[%%expect{|
- : unit = ()
|}];;
let l2 = l1#map (fun x -> x + 1);;
l2#print print_int;;
[%%expect{|
val l2 : int lst = <obj>
|}];;
l2#print Format.print_int;;
[%%expect{|
- : unit = ()
|}];;
let rec map_list f (x:'a lst) =
if x#null then new nil()
else new cons (f x#hd) (map_list f x#tl);;
[%%expect{|
val map_list : ('a -> 'b) -> 'a lst -> 'b lst = <fun>
|}];;
let p1 = (map_list (fun x -> new printable_color_point x "red") l1);;
[%%expect{|
val p1 : printable_color_point lst = <obj>
|}];;
p1#print (fun x -> x#print);;
[%%expect{|
- : unit = ()
|}];;
(*******************************************************************)
class virtual comparable () = object (self : 'a)
method virtual cmp : 'a -> int
end;;
[%%expect{|
class virtual comparable :
unit -> object ('a) method virtual cmp : 'a -> int end
|}];;
class int_comparable (x : int) = object
inherit comparable ()
@ -182,12 +468,27 @@ class int_comparable (x : int) = object
method x = x
method cmp p = compare x p#x
end;;
[%%expect{|
class int_comparable :
int -> object ('a) val x : int method cmp : 'a -> int method x : int end
|}];;
class int_comparable2 xi = object
inherit int_comparable xi
val mutable x' = xi
method set_x y = x' <- y
end;;
[%%expect{|
class int_comparable2 :
int ->
object ('a)
val x : int
val mutable x' : int
method cmp : 'a -> int
method set_x : int -> unit
method x : int
end
|}];;
class ['a] sorted_list () = object
constraint 'a = #comparable
@ -201,14 +502,53 @@ class ['a] sorted_list () = object
l <- insert l
method hd = List.hd l
end;;
[%%expect{|
class ['a] sorted_list :
unit ->
object
constraint 'a = #comparable
val mutable l : 'a list
method add : 'a -> unit
method hd : 'a
end
|}];;
let l = new sorted_list ();;
[%%expect{|
val l : _#comparable sorted_list = <obj>
|}];;
let c = new int_comparable 10;;
[%%expect{|
val c : int_comparable = <obj>
|}];;
l#add c;;
[%%expect{|
- : unit = ()
|}];;
let c2 = new int_comparable2 15;;
l#add (c2 :> int_comparable);; (* Fail : 'a comp2 is not a subtype *)
[%%expect{|
val c2 : int_comparable2 = <obj>
|}];;
l#add (c2 :> int_comparable);;
[%%expect{|
Line _, characters 6-28:
l#add (c2 :> int_comparable);;
^^^^^^^^^^^^^^^^^^^^^^
Error: Type
int_comparable2 =
< cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
is not a subtype of
int_comparable = < cmp : int_comparable -> int; x : int >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not a subtype of
int_comparable2 =
< cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
|}];; (* Fail : 'a comp2 is not a subtype *)
(new sorted_list ())#add c2;;
[%%expect{|
- : unit = ()
|}];;
class int_comparable3 (x : int) = object
val mutable x = x
@ -216,28 +556,112 @@ class int_comparable3 (x : int) = object
method x = x
method setx y = x <- y
end;;
[%%expect{|
class int_comparable3 :
int ->
object
val mutable x : int
method cmp : int_comparable -> int
method setx : int -> unit
method x : int
end
|}];;
let c3 = new int_comparable3 15;;
[%%expect{|
val c3 : int_comparable3 = <obj>
|}];;
l#add (c3 :> int_comparable);;
(new sorted_list ())#add c3;; (* Error; strange message with -principal *)
[%%expect{|
- : unit = ()
|}];;
(new sorted_list ())#add c3;;
[%%expect{|
Line _, characters 25-27:
(new sorted_list ())#add c3;;
^^
Error: This expression has type
int_comparable3 =
< cmp : int_comparable -> int; setx : int -> unit; x : int >
but an expression was expected of type
#comparable as 'a = < cmp : 'a -> int; .. >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not compatible with type
int_comparable3 =
< cmp : int_comparable -> int; setx : int -> unit; x : int >
The first object type has no method setx
|}, Principal{|
Line _, characters 25-27:
(new sorted_list ())#add c3;;
^^
Error: This expression has type
int_comparable3 =
< cmp : int_comparable -> int; setx : int -> unit; x : int >
but an expression was expected of type
#comparable as 'a = < cmp : 'a -> int; .. >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not compatible with type 'a = < cmp : 'a -> int; .. >
The first object type has no method setx
|}];; (* Error; strange message with -principal *)
let sort (l : #comparable list) = List.sort (fun x -> x#cmp) l;;
[%%expect{|
val sort : (#comparable as 'a) list -> 'a list = <fun>
|}];;
let pr l =
List.map (fun c -> print_int c#x; print_string " ") l;
print_newline ();;
List.map (fun c -> Format.print_int c#x; Format.print_string " ") l;
Format.print_newline ();;
[%%expect{|
Line _, characters 2-69:
List.map (fun c -> Format.print_int c#x; Format.print_string " ") l;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10: this expression should have type unit.
val pr : < x : int; .. > list -> unit = <fun>
|}];;
let l = [new int_comparable 5; (new int_comparable3 2 :> int_comparable);
new int_comparable 4];;
[%%expect{|
val l : int_comparable list = [<obj>; <obj>; <obj>]
|}];;
pr l;;
[%%expect{|
7(7, red)(3::10::[])(4::11::[])((3, red)::(10, red)::[])5 2 4
- : unit = ()
|}];;
pr (sort l);;
[%%expect{|
2 4 5
- : unit = ()
|}];;
let l = [new int_comparable2 2; new int_comparable2 0];;
[%%expect{|
val l : int_comparable2 list = [<obj>; <obj>]
|}];;
pr l;;
[%%expect{|
2 0
- : unit = ()
|}];;
pr (sort l);;
[%%expect{|
0 2
- : unit = ()
|}];;
let min (x : #comparable) y =
if x#cmp y <= 0 then x else y;;
[%%expect{|
val min : (#comparable as 'a) -> 'a -> 'a = <fun>
|}];;
(min (new int_comparable 7) (new int_comparable 11))#x;;
[%%expect{|
- : int = 7
|}];;
(min (new int_comparable2 5) (new int_comparable2 3))#x;;
[%%expect{|
- : int = 3
|}];;
(*******************************************************************)
@ -255,6 +679,19 @@ class ['a] link (x : 'a) = object (self : 'b)
| Some l' ->
l'#append l
end;;
[%%expect{|
class ['a] link :
'a ->
object ('b)
val mutable next : 'b option
val mutable x : 'a
method append : 'b option -> unit
method next : 'b option
method set_next : 'b option -> unit
method set_x : 'a -> unit
method x : 'a
end
|}];;
class ['a] double_link x = object (self)
inherit ['a] link x
@ -265,12 +702,31 @@ class ['a] double_link x = object (self)
match l with Some l -> l#set_prev (Some self) | None -> ()
method set_prev l = prev <- l
end;;
[%%expect{|
class ['a] double_link :
'a ->
object ('b)
val mutable next : 'b option
val mutable prev : 'b option
val mutable x : 'a
method append : 'b option -> unit
method next : 'b option
method prev : 'b option
method set_next : 'b option -> unit
method set_prev : 'b option -> unit
method set_x : 'a -> unit
method x : 'a
end
|}];;
let rec fold_right f (l : 'a #link option) accu =
match l with
None -> accu
| Some l ->
f l#x (fold_right f l#next accu);;
[%%expect{|
val fold_right : ('a -> 'b -> 'b) -> 'a #link option -> 'b -> 'b = <fun>
|}];;
(*******************************************************************)
@ -291,10 +747,34 @@ class calculator () = object (self)
self
method equals = equals self
end;;
[%%expect{|
class calculator :
unit ->
object ('a)
val mutable acc : float
val mutable arg : float
val mutable equals : 'a -> float
method acc : float
method add : 'a
method arg : float
method enter : float -> 'a
method equals : float
method sub : 'a
end
|}];;
((new calculator ())#enter 5.)#equals;;
[%%expect{|
- : float = 5.
|}];;
(((new calculator ())#enter 5.)#sub#enter 3.5)#equals;;
[%%expect{|
- : float = 1.5
|}];;
((new calculator ())#enter 5.)#add#add#equals;;
[%%expect{|
- : float = 15.
|}];;
class calculator () = object (self)
val mutable arg = 0.
@ -307,10 +787,34 @@ class calculator () = object (self)
method sub = {< acc = equals self; equals = function s -> s#acc -. s#arg >}
method equals = equals self
end;;
[%%expect{|
class calculator :
unit ->
object ('a)
val mutable acc : float
val mutable arg : float
val mutable equals : 'a -> float
method acc : float
method add : 'a
method arg : float
method enter : float -> 'a
method equals : float
method sub : 'a
end
|}];;
((new calculator ())#enter 5.)#equals;;
[%%expect{|
- : float = 5.
|}];;
(((new calculator ())#enter 5.)#sub#enter 3.5)#equals;;
[%%expect{|
- : float = 1.5
|}];;
((new calculator ())#enter 5.)#add#add#equals;;
[%%expect{|
- : float = 15.
|}];;
class calculator arg acc = object (self)
val arg = arg
@ -328,9 +832,56 @@ end and calculator_sub arg acc = object
method enter n = new calculator_sub n acc
method equals = acc -. arg
end;;
[%%expect{|
class calculator :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
and calculator_add :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
and calculator_sub :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
|}];;
let calculator = new calculator 0. 0.;;
[%%expect{|
val calculator : calculator = <obj>
|}];;
(calculator#enter 5.)#equals;;
[%%expect{|
- : float = 5.
|}];;
((calculator#enter 5.)#sub#enter 3.5)#equals;;
[%%expect{|
- : float = 1.5
|}];;
(calculator#enter 5.)#add#add#equals;;
[%%expect{|
- : float = 15.
|}];;

358
testsuite/tests/typing-objects/Exemples.ml.principal.reference
View File

@ -1,358 +0,0 @@
# class point :
int ->
object val mutable x : int method get_x : int method move : int -> unit end
# val p : point = <obj>
# - : int = 7
# - : unit = ()
# - : int = 10
# val q : < get_x : int; move : int -> unit > = <obj>
# - : int * int = (10, 17)
# class color_point :
int ->
string ->
object
val c : string
val mutable x : int
method color : string
method get_x : int
method move : int -> unit
end
# val p' : color_point = <obj>
# - : int * string = (5, "red")
# val l : point list = [<obj>; <obj>]
# val get_x : < get_x : 'a; .. > -> 'a = <fun>
# val set_x : < set_x : 'a; .. > -> 'a = <fun>
# - : int list = [10; 5]
# Characters 1-96:
class ref x_init = object
val mutable x = x_init
method get = x
method set y = x <- y
end..
Error: Some type variables are unbound in this type:
class ref :
'a ->
object
val mutable x : 'a
method get : 'a
method set : 'a -> unit
end
The method get has type 'a where 'a is unbound
# class ref :
int ->
object val mutable x : int method get : int method set : int -> unit end
# class ['a] ref :
'a -> object val mutable x : 'a method get : 'a method set : 'a -> unit end
# - : int = 2
# class ['a] circle :
'a ->
object
constraint 'a = < move : int -> unit; .. >
val mutable center : 'a
method center : 'a
method move : int -> unit
method set_center : 'a -> unit
end
# class ['a] circle :
'a ->
object
constraint 'a = #point
val mutable center : 'a
method center : 'a
method move : int -> unit
method set_center : 'a -> unit
end
# val c : point circle = <obj>
val c' : < color : string; get_x : int; move : int -> unit > circle = <obj>
# class ['a] color_circle :
'a ->
object
constraint 'a = #color_point
val mutable center : 'a
method center : 'a
method color : string
method move : int -> unit
method set_center : 'a -> unit
end
# Characters 28-29:
let c'' = new color_circle p;;
^
Error: This expression has type point but an expression was expected of type
#color_point
The first object type has no method color
# val c'' : color_point color_circle = <obj>
# - : color_point circle = <obj>
# Characters 0-21:
(c'' :> point circle);; (* Fail *)
^^^^^^^^^^^^^^^^^^^^^
Error: Type
color_point color_circle =
< center : color_point; color : string; move : int -> unit;
set_center : color_point -> unit >
is not a subtype of
point circle =
< center : point; move : int -> unit; set_center : point -> unit >
Type point is not a subtype of color_point
# Characters 9-55:
fun x -> (x : color_point color_circle :> point circle);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type
color_point color_circle =
< center : color_point; color : string; move : int -> unit;
set_center : color_point -> unit >
is not a subtype of
point circle =
< center : point; move : int -> unit; set_center : point -> unit >
Type point is not a subtype of color_point
# class printable_point :
int ->
object
val mutable x : int
method get_x : int
method move : int -> unit
method print : unit
end
# val p : printable_point = <obj>
# 7- : unit = ()
# Characters 85-102:
inherit printable_point y as super
^^^^^^^^^^^^^^^^^
Warning 13: the following instance variables are overridden by the class printable_point :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class printable_color_point :
int ->
string ->
object
val c : string
val mutable x : int
method color : string
method get_x : int
method move : int -> unit
method print : unit
end
# val p' : printable_color_point = <obj>
# (7, red)- : unit = ()
# class functional_point :
int ->
object ('a) val x : int method get_x : int method move : int -> 'a end
# val p : functional_point = <obj>
# - : int = 7
# - : int = 10
# - : int = 7
# - : #functional_point -> functional_point = <fun>
# class virtual ['a] lst :
unit ->
object
method virtual hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method virtual null : bool
method print : ('a -> unit) -> unit
method virtual tl : 'a lst
end
and ['a] nil :
unit ->
object
method hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method null : bool
method print : ('a -> unit) -> unit
method tl : 'a lst
end
and ['a] cons :
'a ->
'a lst ->
object
val h : 'a
val t : 'a lst
method hd : 'a
method iter : ('a -> unit) -> unit
method map : ('a -> 'a) -> 'a lst
method null : bool
method print : ('a -> unit) -> unit
method tl : 'a lst
end
# val l1 : int lst = <obj>
# (3::10::[])- : unit = ()
# val l2 : int lst = <obj>
# (4::11::[])- : unit = ()
# val map_list : ('a -> 'b) -> 'a lst -> 'b lst = <fun>
# val p1 : printable_color_point lst = <obj>
# ((3, red)::(10, red)::[])- : unit = ()
# class virtual comparable :
unit -> object ('a) method virtual cmp : 'a -> int end
# class int_comparable :
int -> object ('a) val x : int method cmp : 'a -> int method x : int end
# class int_comparable2 :
int ->
object ('a)
val x : int
val mutable x' : int
method cmp : 'a -> int
method set_x : int -> unit
method x : int
end
# class ['a] sorted_list :
unit ->
object
constraint 'a = #comparable
val mutable l : 'a list
method add : 'a -> unit
method hd : 'a
end
# val l : _#comparable sorted_list = <obj>
# val c : int_comparable = <obj>
# - : unit = ()
# val c2 : int_comparable2 = <obj>
# Characters 6-28:
l#add (c2 :> int_comparable);; (* Fail : 'a comp2 is not a subtype *)
^^^^^^^^^^^^^^^^^^^^^^
Error: Type
int_comparable2 =
< cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
is not a subtype of
int_comparable = < cmp : int_comparable -> int; x : int >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not a subtype of
int_comparable2 =
< cmp : int_comparable2 -> int; set_x : int -> unit; x : int >
# - : unit = ()
# class int_comparable3 :
int ->
object
val mutable x : int
method cmp : int_comparable -> int
method setx : int -> unit
method x : int
end
# val c3 : int_comparable3 = <obj>
# - : unit = ()
# Characters 25-27:
(new sorted_list ())#add c3;; (* Error; strange message with -principal *)
^^
Error: This expression has type
int_comparable3 =
< cmp : int_comparable -> int; setx : int -> unit; x : int >
but an expression was expected of type
#comparable as 'a = < cmp : 'a -> int; .. >
Type int_comparable = < cmp : int_comparable -> int; x : int >
is not compatible with type 'a = < cmp : 'a -> int; .. >
The first object type has no method setx
# val sort : (#comparable as 'a) list -> 'a list = <fun>
# Characters 13-66:
List.map (fun c -> print_int c#x; print_string " ") l;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Warning 10: this expression should have type unit.
val pr : < x : int; .. > list -> unit = <fun>
# val l : int_comparable list = [<obj>; <obj>; <obj>]
# 5 2 4
- : unit = ()
# 2 4 5
- : unit = ()
# val l : int_comparable2 list = [<obj>; <obj>]
# 2 0
- : unit = ()
# 0 2
- : unit = ()
# val min : (#comparable as 'a) -> 'a -> 'a = <fun>
# - : int = 7
# - : int = 3
# class ['a] link :
'a ->
object ('b)
val mutable next : 'b option
val mutable x : 'a
method append : 'b option -> unit
method next : 'b option
method set_next : 'b option -> unit
method set_x : 'a -> unit
method x : 'a
end
# class ['a] double_link :
'a ->
object ('b)
val mutable next : 'b option
val mutable prev : 'b option
val mutable x : 'a
method append : 'b option -> unit
method next : 'b option
method prev : 'b option
method set_next : 'b option -> unit
method set_prev : 'b option -> unit
method set_x : 'a -> unit
method x : 'a
end
# val fold_right : ('a -> 'b -> 'b) -> 'a #link option -> 'b -> 'b = <fun>
# class calculator :
unit ->
object ('a)
val mutable acc : float
val mutable arg : float
val mutable equals : 'a -> float
method acc : float
method add : 'a
method arg : float
method enter : float -> 'a
method equals : float
method sub : 'a
end
# - : float = 5.
# - : float = 1.5
# - : float = 15.
# class calculator :
unit ->
object ('a)
val mutable acc : float
val mutable arg : float
val mutable equals : 'a -> float
method acc : float
method add : 'a
method arg : float
method enter : float -> 'a
method equals : float
method sub : 'a
end
# - : float = 5.
# - : float = 1.5
# - : float = 15.
# class calculator :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
and calculator_add :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
and calculator_sub :
float ->
float ->
object
val acc : float
val arg : float
method add : calculator
method enter : float -> calculator
method equals : float
method sub : calculator
end
# val calculator : calculator = <obj>
# - : float = 5.
# - : float = 1.5
# - : float = 15.
#

316
testsuite/tests/typing-objects/Tests.compilers.reference
View File

@ -1,316 +0,0 @@
- : < x : int > ->
< x : int > -> < x : int > -> < x : int > * < x : int > * < x : int >
= <fun>
class ['a] c : unit -> object constraint 'a = int method f : int c end
and ['a] d : unit -> object constraint 'a = int method f : int c end
Characters 230-271:
....and d () = object
inherit ['a] c ()
end..
Error: Some type variables are unbound in this type:
class d : unit -> object method f : 'a -> unit end
The method f has type 'a -> unit where 'a is unbound
class virtual c : unit -> object end
and ['a] d :
unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end
class ['a] c : unit -> object constraint 'a = int end
and ['a] d : unit -> object constraint 'a = int #c end
class ['a] c :
'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
- : ('a c as 'a) -> 'a = <fun>
Characters 128-176:
class x () = object
method virtual f : int
end..
Error: This class should be virtual. The following methods are undefined : f
Characters 144-152:
class virtual c ((x : 'a): < f : int >) = object (_ : 'a) end
^^^^^^^^
Error: This pattern cannot match self: it only matches values of type
< f : int >
Characters 32-110:
class ['a] c () = object
constraint 'a = int
method f x = (x : bool c)
end..
Error: The abbreviation c is used with parameters bool c
which are incompatible with constraints int c
class ['a, 'b] c :
unit ->
object
constraint 'a = int -> 'c
constraint 'b = 'a * < x : 'b > * 'c * 'd
method f : 'a -> 'b -> unit
end
class ['a, 'b] d :
unit ->
object
constraint 'a = int -> 'c
constraint 'b = 'a * < x : 'b > * 'c * 'd
method f : 'a -> 'b -> unit
end
val x : '_weak1 list ref = {contents = []}
Characters 0-50:
class ['a] c () = object
method f = (x : 'a)
end..
Error: The type of this class,
class ['a] c :
unit -> object constraint 'a = '_weak1 list ref method f : 'a end,
contains type variables that cannot be generalized
Characters 21-53:
type 'a c = <f : 'a c; g : 'a d>
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In the definition of d, type int c should be 'a c
type 'a c = < f : 'a c; g : 'a d >
and 'a d = < f : 'a c >
type 'a c = < f : 'a c >
and 'a d = < f : int c >
Characters 22-39:
and 'a t = 'a t u;; (* fails since 4.04 *)
^^^^^^^^^^^^^^^^^
Error: The definition of t contains a cycle:
'a t u
Characters 15-32:
and 'a t = 'a t u;;
^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
type 'a u = 'a
Characters 0-18:
type t = t u * t u;;
^^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
type t = < x : 'a > as 'a
type 'a u = 'a
- : t -> t u -> bool = <fun>
- : t -> t u -> bool = <fun>
module M :
sig
class ['a, 'b] c :
int ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
end
module M' :
sig
class virtual ['a, 'b] c :
int ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
end
class ['a, 'b] d :
unit ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
class ['a, 'b] e :
unit ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
- : string = "a"
- : int = 10
- : float = 7.1
- : bool = true
module M : sig class ['a] c : unit -> object method f : 'a -> unit end end
module M' : sig class ['a] c : unit -> object method f : 'a -> unit end end
- : ('a #M.c as 'b) -> 'b = <fun>
- : ('a #M'.c as 'b) -> 'b = <fun>
class ['a] c : 'a #c -> object end
class ['a] c : 'a #c -> object end
class c : unit -> object method f : int end
and d : unit -> object method f : int end
class e : unit -> object method f : int end
- : int = 2
Characters 30-34:
class c () = object val x = - true val y = -. () end;;
^^^^
Error: This expression has type bool but an expression was expected of type
int
class c : unit -> object method f : int method g : int method h : int end
class d : unit -> object method h : int method i : int method j : int end
class e :
unit ->
object
method f : int
method g : int
method h : int
method i : int
method j : int
end
val e : e = <obj>
- : int * int * int * int * int = (1, 3, 2, 2, 3)
class c : 'a -> object val a : 'a val x : int val y : int val z : int end
class d : 'a -> object val b : 'a val t : int val u : int val z : int end
Characters 42-45:
inherit c 5
^^^
Warning 13: the following instance variables are overridden by the class c :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Characters 52-53:
val y = 3
^
Warning 13: the instance variable y is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Characters 80-83:
inherit d 7
^^^
Warning 13: the following instance variables are overridden by the class d :
t z
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Characters 90-91:
val u = 3
^
Warning 13: the instance variable u is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class e :
unit ->
object
val a : int
val b : int
val t : int
val u : int
val x : int
val y : int
val z : int
method a : int
method b : int
method t : int
method u : int
method x : int
method y : int
method z : int
end
val e : e = <obj>
- : int * int * int * int * int * int * int = (1, 3, 2, 2, 3, 5, 7)
class c :
int ->
int -> object val x : int val y : int method x : int method y : int end
class d :
int ->
int -> object val x : int val y : int method x : int method y : int end
- : int * int = (1, 2)
- : int * int = (1, 2)
class ['a] c : 'a -> object end
- : 'a -> 'a c = <fun>
module M : sig class c : unit -> object method xc : int end end
class d : unit -> object val x : int method xc : int method xd : int end
- : int * int = (1, 2)
Characters 1-154:
class virtual ['a] matrix (sz, init : int * 'a) = object
val m = Array.make_matrix sz sz init
method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
end..
Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
but is used with type < m : 'a array array; .. >
class c : unit -> object method m : c end
- : c = <obj>
module M : sig class c : unit -> object method m : c end end
- : M.c = <obj>
type uu = A of int | B of (< leq : 'a > as 'a)
class virtual c : unit -> object ('a) method virtual m : 'a end
module S : sig val f : (#c as 'a) -> 'a end
Characters 12-43:
............struct
let f (x : #c) = x
end......
Error: Signature mismatch:
Modules do not match:
sig val f : (#c as 'a) -> 'a end
is not included in
sig val f : #c -> #c end
Values do not match:
val f : (#c as 'a) -> 'a
is not included in
val f : #c -> #c
Characters 38-39:
module M = struct type t = int class t () = object end end;;
^
Error: Multiple definition of the type name t.
Names must be unique in a given structure or signature.
- : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = <fun>
Characters 10-39:
fun x -> (x : int -> bool :> 'a -> 'a);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type int -> bool is not a subtype of int -> int
Type bool is not a subtype of int
Characters 9-40:
fun x -> (x : int -> bool :> int -> int);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type int -> bool is not a subtype of int -> int
Type bool is not a subtype of int
- : < > -> < > = <fun>
- : < .. > -> < > = <fun>
val x : '_weak2 list ref = {contents = []}
module F : functor (X : sig end) -> sig type t = int end
- : < m : int > list ref = {contents = []}
type 'a t
Characters 9-19:
fun (x : 'a t as 'a) -> ();;
^^^^^^^^^^
Error: This alias is bound to type 'a t but is used as an instance of type 'a
The type variable 'a occurs inside 'a t
Characters 19-20:
fun (x : 'a t) -> (x : 'a); ();;
^
Error: This expression has type 'a t but an expression was expected of type
'a
The type variable 'a occurs inside 'a t
type 'a t = < x : 'a >
- : ('a t as 'a) -> unit = <fun>
Characters 18-26:
fun (x : 'a t) -> (x : 'a); ();;
^^^^^^^^
Warning 10: this expression should have type unit.
- : ('a t as 'a) t -> unit = <fun>
class ['a] c :
unit ->
object constraint 'a = (< .. > as 'b) -> unit method m : 'b -> unit end
class ['a] c :
unit ->
object constraint 'a = unit -> (< .. > as 'b) method m : 'a -> 'b end
class c : unit -> object method private m : int method n : int end
class d :
unit -> object method private m : int method n : int method o : int end
- : int * int = (1, 1)
class c : unit -> object method m : int end
val r : int ref = {contents = 0}
val id : < .. > -> int = <fun>
- : unit = ()
- : int = 1
- : int = 2
- : int * int * int = (3, 4, 5)
- : int * int * int * int * int = (6, 7, 8, 33, 33)
- : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33)
Characters 42-69:
class a = let _ = new b in object end
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed
Characters 11-38:
class a = let _ = new a in object end;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed

552
testsuite/tests/typing-objects/Tests.ml
View File

@ -1,9 +1,14 @@
(* TEST
* toplevel
* expect
*)
(* Subtyping is "syntactic" *)
fun (x : < x : int >) y z -> (y :> 'a), (x :> 'a), (z :> 'a);;
[%%expect{|
- : < x : int > ->
< x : int > -> < x : int > -> < x : int > * < x : int > * < x : int >
= <fun>
|}];;
(* - : (< x : int > as 'a) -> 'a -> 'a * 'a = <fun> *)
(* Quirks of class typing. *)
@ -12,6 +17,10 @@ class ['a] c () = object
end and ['a] d () = object
inherit ['a] c ()
end;;
[%%expect{|
class ['a] c : unit -> object constraint 'a = int method f : int c end
and ['a] d : unit -> object constraint 'a = int method f : int c end
|}];;
(* class ['a] c : unit -> object constraint 'a = int method f : 'a c end *)
(* and ['a] d : unit -> object constraint 'a = int method f : 'a c end *)
@ -21,6 +30,15 @@ class ['a] c () = object
end and d () = object
inherit ['a] c ()
end;;
[%%expect{|
Line _, characters 4-45:
....and d () = object
inherit ['a] c ()
end..
Error: Some type variables are unbound in this type:
class d : unit -> object method f : 'a -> unit end
The method f has type 'a -> unit where 'a is unbound
|}];;
(* Create instance #c *)
class virtual c () = object
@ -28,6 +46,11 @@ end and ['a] d () = object
constraint 'a = #c
method f (x : #c) = (x#x : int)
end;;
[%%expect{|
class virtual c : unit -> object end
and ['a] d :
unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end
|}];;
(* class virtual c : unit -> object end *)
(* and ['a] d : *)
(* unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end *)
@ -37,6 +60,10 @@ class ['a] c () = object
end and ['a] d () = object
constraint 'a = 'b #c
end;;
[%%expect{|
class ['a] c : unit -> object constraint 'a = int end
and ['a] d : unit -> object constraint 'a = int #c end
|}];;
(* class ['a] c : unit -> object constraint 'a = int end
and ['a] d : unit -> object constraint 'a = int #c end *)
@ -45,7 +72,14 @@ class ['a] c (x : 'a) = object (self : 'b)
constraint 'a = 'b
method f = self
end;;
[%%expect{|
class ['a] c :
'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
|}];;
new c;;
[%%expect{|
- : ('a c as 'a) -> 'a = <fun>
|}];;
(* class ['a] c :
'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end *)
(* - : ('a c as 'a) -> 'a = <fun> *)
@ -53,6 +87,13 @@ new c;;
class x () = object
method virtual f : int
end;;
[%%expect{|
Line _, characters 0-48:
class x () = object
method virtual f : int
end..
Error: This class should be virtual. The following methods are undefined : f
|}];;
(* The class x should be virtual: its methods f is undefined *)
(* Supplementary method g *)
@ -61,12 +102,28 @@ and virtual d x = object (_ : 'a)
inherit c x
method g = true
end;;
[%%expect{|
Line _, characters 49-57:
class virtual c ((x : 'a): < f : int >) = object (_ : 'a) end
^^^^^^^^
Error: This pattern cannot match self: it only matches values of type
< f : int >
|}];;
(* Constraint not respected *)
class ['a] c () = object
constraint 'a = int
method f x = (x : bool c)
end;;
[%%expect{|
Line _, characters 0-78:
class ['a] c () = object
constraint 'a = int
method f x = (x : bool c)
end..
Error: The abbreviation c is used with parameters bool c
which are incompatible with constraints int c
|}];;
(* Different constraints *)
class ['a, 'b] c () = object
@ -74,34 +131,113 @@ class ['a, 'b] c () = object
constraint 'b = 'a * <x : 'b> * 'c * 'd
method f (x : 'a) (y : 'b) = ()
end;;
[%%expect{|
class ['a, 'b] c :
unit ->
object
constraint 'a = int -> 'c
constraint 'b = 'a * < x : 'b > * 'c * 'd
method f : 'a -> 'b -> unit
end
|}];;
class ['a, 'b] d () = object
inherit ['a, 'b] c ()
end;;
[%%expect{|
class ['a, 'b] d :
unit ->
object
constraint 'a = int -> 'c
constraint 'b = 'a * < x : 'b > * 'c * 'd
method f : 'a -> 'b -> unit
end
|}];;
(* Non-generic constraint *)
let x = ref [];;
[%%expect{|
val x : '_weak1 list ref = {contents = []}
|}];;
class ['a] c () = object
method f = (x : 'a)
end;;
[%%expect{|
Line _, characters 0-50:
class ['a] c () = object
method f = (x : 'a)
end..
Error: The type of this class,
class ['a] c :
unit -> object constraint 'a = '_weak1 list ref method f : 'a end,
contains type variables that cannot be generalized
|}];;
(* Abbreviations *)
type 'a c = <f : 'a c; g : 'a d>
and 'a d = <f : int c>;;
[%%expect{|
Line _, characters 0-32:
type 'a c = <f : 'a c; g : 'a d>
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In the definition of d, type int c should be 'a c
|}];;
type 'a c = <f : 'a c; g : 'a d>
and 'a d = <f : 'a c>;;
[%%expect{|
type 'a c = < f : 'a c; g : 'a d >
and 'a d = < f : 'a c >
|}];;
type 'a c = <f : 'a c>
and 'a d = <f : int c>;;
[%%expect{|
type 'a c = < f : 'a c >
and 'a d = < f : int c >
|}];;
type 'a u = < x : 'a>
and 'a t = 'a t u;; (* fails since 4.04 *)
and 'a t = 'a t u;;
[%%expect{|
Line _, characters 0-17:
and 'a t = 'a t u;;
^^^^^^^^^^^^^^^^^
Error: The definition of t contains a cycle:
'a t u
|}];; (* fails since 4.04 *)
type 'a u = 'a
and 'a t = 'a t u;;
[%%expect{|
Line _, characters 0-17:
and 'a t = 'a t u;;
^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
|}];;
type 'a u = 'a;;
[%%expect{|
type 'a u = 'a
|}];;
type t = t u * t u;;
[%%expect{|
Line _, characters 0-18:
type t = t u * t u;;
^^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
|}];;
type t = <x : 'a> as 'a;;
[%%expect{|
type t = < x : 'a > as 'a
|}];;
type 'a u = 'a;;
[%%expect{|
type 'a u = 'a
|}];;
fun (x : t) (y : 'a u) -> x = y;;
[%%expect{|
- : t -> t u -> bool = <fun>
|}];;
fun (x : t) (y : 'a u) -> y = x;;
[%%expect{|
- : t -> t u -> bool = <fun>
|}];;
(* - : t -> t u -> bool = <fun> *)
(* Modules *)
@ -115,6 +251,21 @@ module M =
method g = y
end
end;;
[%%expect{|
module M :
sig
class ['a, 'b] c :
int ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
end
|}];;
module M' = (M :
sig
class virtual ['a, 'b] c : int -> 'b -> object
@ -125,31 +276,125 @@ module M' = (M :
method g : 'b
end
end);;
[%%expect{|
module M' :
sig
class virtual ['a, 'b] c :
int ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
end
|}];;
class ['a, 'b] d () y = object inherit ['a, 'b] M.c 7 y end;;
[%%expect{|
class ['a, 'b] d :
unit ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
|}];;
class ['a, 'b] e () y = object inherit ['a, 'b] M'.c 1 y end;;
[%%expect{|
class ['a, 'b] e :
unit ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
|}];;
(new M.c 3 "a")#g;;
[%%expect{|
- : string = "a"
|}];;
(new d () 10)#g;;
[%%expect{|
- : int = 10
|}];;
(new e () 7.1)#g;;
[%%expect{|
- : float = 7.1
|}];;
open M;;
[%%expect{|
|}];;
(new c 5 true)#g;;
[%%expect{|
- : bool = true
|}];;
(* #cl when cl is closed *)
module M = struct class ['a] c () = object method f (x : 'a) = () end end;;
[%%expect{|
module M : sig class ['a] c : unit -> object method f : 'a -> unit end end
|}];;
module M' =
(M : sig class ['a] c : unit -> object method f : 'a -> unit end end);;
[%%expect{|
module M' : sig class ['a] c : unit -> object method f : 'a -> unit end end
|}];;
fun x -> (x :> 'a #M.c);;
[%%expect{|
- : ('a #M.c as 'b) -> 'b = <fun>
|}];;
fun x -> (x :> 'a #M'.c);;
[%%expect{|
- : ('a #M'.c as 'b) -> 'b = <fun>
|}];;
class ['a] c (x : 'b #c) = object end;;
[%%expect{|
class ['a] c : 'a #c -> object end
|}];;
class ['a] c (x : 'b #c) = object end;;
[%%expect{|
class ['a] c : 'a #c -> object end
|}];;
(* Computation order *)
class c () = object method f = 1 end and d () = object method f = 2 end;;
[%%expect{|
class c : unit -> object method f : int end
and d : unit -> object method f : int end
|}];;
class e () = object inherit c () inherit d () end;;
[%%expect{|
class e : unit -> object method f : int end
|}];;
(new e ())#f;;
[%%expect{|
- : int = 2
|}];;
class c () = object val x = - true val y = -. () end;;
[%%expect{|
Line _, characters 30-34:
class c () = object val x = - true val y = -. () end;;
^^^^
Error: This expression has type bool but an expression was expected of type
int
|}];;
class c () = object method f = 1 method g = 1 method h = 1 end;;
[%%expect{|
class c : unit -> object method f : int method g : int method h : int end
|}];;
class d () = object method h = 2 method i = 2 method j = 2 end;;
[%%expect{|
class d : unit -> object method h : int method i : int method j : int end
|}];;
class e () = object
method f = 3
inherit c ()
@ -158,11 +403,34 @@ class e () = object
inherit d ()
method j = 3
end;;
[%%expect{|
class e :
unit ->
object
method f : int
method g : int
method h : int
method i : int
method j : int
end
|}];;
let e = new e ();;
[%%expect{|
val e : e = <obj>
|}];;
e#f, e#g, e#h, e#i, e#j;;
[%%expect{|
- : int * int * int * int * int = (1, 3, 2, 2, 3)
|}];;
class c a = object val x = 1 val y = 1 val z = 1 val a = a end;;
[%%expect{|
class c : 'a -> object val a : 'a val x : int val y : int val z : int end
|}];;
class d b = object val z = 2 val t = 2 val u = 2 val b = b end;;
[%%expect{|
class d : 'a -> object val b : 'a val t : int val u : int val z : int end
|}];;
class e () = object
val x = 3
inherit c 5
@ -178,8 +446,56 @@ class e () = object
method a = a
method b = b
end;;
[%%expect{|
Line _, characters 10-13:
inherit c 5
^^^
Warning 13: the following instance variables are overridden by the class c :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Line _, characters 6-7:
val y = 3
^
Warning 13: the instance variable y is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Line _, characters 10-13:
inherit d 7
^^^
Warning 13: the following instance variables are overridden by the class d :
t z
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Line _, characters 6-7:
val u = 3
^
Warning 13: the instance variable u is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class e :
unit ->
object
val a : int
val b : int
val t : int
val u : int
val x : int
val y : int
val z : int
method a : int
method b : int
method t : int
method u : int
method x : int
method y : int
method z : int
end
|}];;
let e = new e ();;
[%%expect{|
val e : e = <obj>
|}];;
e#x, e#y, e#z, e#t, e#u, e#a, e#b;;
[%%expect{|
- : int * int * int * int * int * int * int = (1, 3, 2, 2, 3, 5, 7)
|}];;
class c (x : int) (y : int) = object
val x = x
@ -187,13 +503,35 @@ class c (x : int) (y : int) = object
method x = x
method y = y
end;;
[%%expect{|
class c :
int ->
int -> object val x : int val y : int method x : int method y : int end
|}];;
class d x y = object inherit c x y end;;
[%%expect{|
class d :
int ->
int -> object val x : int val y : int method x : int method y : int end
|}];;
let c = new c 1 2 in c#x, c#y;;
[%%expect{|
- : int * int = (1, 2)
|}];;
let d = new d 1 2 in d#x, d#y;;
[%%expect{|
- : int * int = (1, 2)
|}];;
(* Parameters which does not appear in the object type *)
class ['a] c (x : 'a) = object end;;
[%%expect{|
class ['a] c : 'a -> object end
|}];;
new c;;
[%%expect{|
- : 'a -> 'a c = <fun>
|}];;
(* Private variables *)
(*
@ -201,22 +539,49 @@ module type M = sig
class c : unit -> object val x : int end
class d : unit -> object inherit c val private x : int val x : bool end
end;;
[%%expect{|
foo
|}];;
class c (x : int) =
val private mutable x = x
method get = x
method set y = x <- y
end;;
[%%expect{|
foo
|}];;
let c = new c 5;;
[%%expect{|
foo
|}];;
c#get;;
[%%expect{|
foo
|}];;
c#set 7; c#get;;
[%%expect{|
foo
|}];;
class c () = val x = 1 val y = 1 method c = x end;;
[%%expect{|
foo
|}];;
class d () = inherit c () val private x method d = x end;;
[%%expect{|
foo
|}];;
class e () =
val x = 2 val y = 2 inherit d () method x = x method y = y
end;;
[%%expect{|
foo
|}];;
let e = new e () in e#x, e#y, e#c, e#d;;
[%%expect{|
foo
|}];;
*)
(* Forgotten variables in interfaces *)
@ -232,109 +597,292 @@ module M :
method xc = x
end
end;;
[%%expect{|
module M : sig class c : unit -> object method xc : int end end
|}];;
class d () = object
val x = 2
method xd = x
inherit M.c ()
end;;
[%%expect{|
class d : unit -> object val x : int method xc : int method xd : int end
|}];;
let d = new d () in d#xc, d#xd;;
[%%expect{|
- : int * int = (1, 2)
|}];;
class virtual ['a] matrix (sz, init : int * 'a) = object
val m = Array.make_matrix sz sz init
method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
end;;
[%%expect{|
Line _, characters 0-153:
class virtual ['a] matrix (sz, init : int * 'a) = object
val m = Array.make_matrix sz sz init
method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
end..
Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
but is used with type < m : 'a array array; .. >
|}];;
class c () = object method m = new c () end;;
[%%expect{|
class c : unit -> object method m : c end
|}];;
(new c ())#m;;
[%%expect{|
- : c = <obj>
|}];;
module M = struct class c () = object method m = new c () end end;;
[%%expect{|
module M : sig class c : unit -> object method m : c end end
|}];;
(new M.c ())#m;;
[%%expect{|
- : M.c = <obj>
|}];;
type uu = A of int | B of (<leq: 'a> as 'a);;
[%%expect{|
type uu = A of int | B of (< leq : 'a > as 'a)
|}];;
class virtual c () = object (_ : 'a) method virtual m : 'a end;;
[%%expect{|
class virtual c : unit -> object ('a) method virtual m : 'a end
|}];;
module S = (struct
let f (x : #c) = x
end : sig
val f : (#c as 'a) -> 'a
end);;
[%%expect{|
module S : sig val f : (#c as 'a) -> 'a end
|}];;
module S = (struct
let f (x : #c) = x
end : sig
val f : #c -> #c
end);;
[%%expect{|
Line _, characters 12-43:
............struct
let f (x : #c) = x
end......
Error: Signature mismatch:
Modules do not match:
sig val f : (#c as 'a) -> 'a end
is not included in
sig val f : #c -> #c end
Values do not match:
val f : (#c as 'a) -> 'a
is not included in
val f : #c -> #c
|}];;
module M = struct type t = int class t () = object end end;;
[%%expect{|
Line _, characters 37-38:
module M = struct type t = int class t () = object end end;;
^
Error: Multiple definition of the type name t.
Names must be unique in a given structure or signature.
|}];;
fun x -> (x :> < m : 'a -> 'a > as 'a);;
[%%expect{|
- : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = <fun>
|}];;
fun x -> (x : int -> bool :> 'a -> 'a);;
[%%expect{|
Line _, characters 9-38:
fun x -> (x : int -> bool :> 'a -> 'a);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type int -> bool is not a subtype of int -> int
Type bool is not a subtype of int
|}];;
fun x -> (x : int -> bool :> int -> int);;
[%%expect{|
Line _, characters 9-40:
fun x -> (x : int -> bool :> int -> int);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type int -> bool is not a subtype of int -> int
Type bool is not a subtype of int
|}];;
fun x -> (x : < > :> < .. >);;
[%%expect{|
- : < > -> < > = <fun>
|}];;
fun x -> (x : < .. > :> < >);;
[%%expect{|
- : < .. > -> < > = <fun>
|}];;
let x = ref [];;
[%%expect{|
val x : '_weak2 list ref = {contents = []}
|}];;
module F(X : sig end) =
struct type t = int let _ = (x : < m : t> list ref) end;;
[%%expect{|
module F : functor (X : sig end) -> sig type t = int end
|}];;
x;;
[%%expect{|
- : < m : int > list ref = {contents = []}
|}];;
type 'a t;;
[%%expect{|
type 'a t
|}];;
fun (x : 'a t as 'a) -> ();;
[%%expect{|
Line _, characters 9-19:
fun (x : 'a t as 'a) -> ();;
^^^^^^^^^^
Error: This alias is bound to type 'a t but is used as an instance of type 'a
The type variable 'a occurs inside 'a t
|}];;
fun (x : 'a t) -> (x : 'a); ();;
[%%expect{|
Line _, characters 19-20:
fun (x : 'a t) -> (x : 'a); ();;
^
Error: This expression has type 'a t but an expression was expected of type
'a
The type variable 'a occurs inside 'a t
|}];;
type 'a t = < x : 'a >;;
[%%expect{|
type 'a t = < x : 'a >
|}];;
fun (x : 'a t as 'a) -> ();;
[%%expect{|
- : ('a t as 'a) -> unit = <fun>
|}];;
fun (x : 'a t) -> (x : 'a); ();;
[%%expect{|
Line _, characters 18-26:
fun (x : 'a t) -> (x : 'a); ();;
^^^^^^^^
Warning 10: this expression should have type unit.
- : ('a t as 'a) t -> unit = <fun>
|}];;
class ['a] c () = object
constraint 'a = < .. > -> unit
method m = (fun x -> () : 'a)
end;;
[%%expect{|
class ['a] c :
unit ->
object constraint 'a = (< .. > as 'b) -> unit method m : 'b -> unit end
|}];;
class ['a] c () = object
constraint 'a = unit -> < .. >
method m (f : 'a) = f ()
end;;
[%%expect{|
class ['a] c :
unit ->
object constraint 'a = unit -> (< .. > as 'b) method m : 'a -> 'b end
|}];;
class c () = object (self)
method private m = 1
method n = self#m
end;;
[%%expect{|
class c : unit -> object method private m : int method n : int end
|}];;
class d () = object (self)
inherit c ()
method o = self#m
end;;
[%%expect{|
class d :
unit -> object method private m : int method n : int method o : int end
|}];;
let x = new d () in x#n, x#o;;
[%%expect{|
- : int * int = (1, 1)
|}];;
class c () = object method virtual m : int method private m = 1 end;;
[%%expect{|
class c : unit -> object method m : int end
|}];;
(* Marshaling (cf. PR#5436) *)
let r = ref 0;;
[%%expect{|
val r : int ref = {contents = 0}
|}];;
let id o = Oo.id o - !r;;
[%%expect{|
val id : < .. > -> int = <fun>
|}];;
r := Oo.id (object end);;
[%%expect{|
- : unit = ()
|}];;
id (object end);;
[%%expect{|
- : int = 1
|}];;
id (object end);;
[%%expect{|
- : int = 2
|}];;
let o = object end in
let s = Marshal.to_string o [] in
let o' : < > = Marshal.from_string s 0 in
let o'' : < > = Marshal.from_string s 0 in
(id o, id o', id o'');;
[%%expect{|
- : int * int * int = (3, 4, 5)
|}];;
let o = object val x = 33 method m = x end in
let s = Marshal.to_string o [Marshal.Closures] in
let o' : <m:int> = Marshal.from_string s 0 in
let o'' : <m:int> = Marshal.from_string s 0 in
(id o, id o', id o'', o#m, o'#m);;
[%%expect{|
- : int * int * int * int * int = (6, 7, 8, 33, 33)
|}];;
let o = object val x = 33 val y = 44 method m = x end in
let s = Marshal.to_string (o,o) [Marshal.Closures] in
let (o1, o2) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
let (o3, o4) : (<m:int> * <m:int>) = Marshal.from_string s 0 in
(id o, id o1, id o2, id o3, id o4, o#m, o1#m);;
[%%expect{|
- : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33)
|}];;
(* Recursion (cf. PR#5291) *)
class a = let _ = new b in object end
and b = let _ = new a in object end;;
[%%expect{|
Line _, characters 10-37:
class a = let _ = new b in object end
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed
|}];;
class a = let _ = new a in object end;;
[%%expect{|
Line _, characters 10-37:
class a = let _ = new a in object end;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed
|}];;

317
testsuite/tests/typing-objects/Tests.ml.principal.reference
View File

@ -1,317 +0,0 @@
# - : < x : int > ->
< x : int > -> < x : int > -> < x : int > * < x : int > * < x : int >
= <fun>
# class ['a] c : unit -> object constraint 'a = int method f : int c end
and ['a] d : unit -> object constraint 'a = int method f : int c end
# Characters 230-271:
....and d () = object
inherit ['a] c ()
end..
Error: Some type variables are unbound in this type:
class d : unit -> object method f : 'a -> unit end
The method f has type 'a -> unit where 'a is unbound
# class virtual c : unit -> object end
and ['a] d :
unit -> object constraint 'a = < x : int; .. > method f : 'a -> int end
# class ['a] c : unit -> object constraint 'a = int end
and ['a] d : unit -> object constraint 'a = int #c end
# * class ['a] c :
'a -> object ('a) constraint 'a = < f : 'a; .. > method f : 'a end
# - : ('a c as 'a) -> 'a = <fun>
# * Characters 128-176:
class x () = object
method virtual f : int
end..
Error: This class should be virtual. The following methods are undefined : f
# Characters 144-152:
class virtual c ((x : 'a): < f : int >) = object (_ : 'a) end
^^^^^^^^
Error: This pattern cannot match self: it only matches values of type
< f : int >
# Characters 32-110:
class ['a] c () = object
constraint 'a = int
method f x = (x : bool c)
end..
Error: The abbreviation c is used with parameters bool c
which are incompatible with constraints int c
# class ['a, 'b] c :
unit ->
object
constraint 'a = int -> 'c
constraint 'b = 'a * < x : 'b > * 'c * 'd
method f : 'a -> 'b -> unit
end
# class ['a, 'b] d :
unit ->
object
constraint 'a = int -> 'c
constraint 'b = 'a * < x : 'b > * 'c * 'd
method f : 'a -> 'b -> unit
end
# val x : '_weak1 list ref = {contents = []}
# Characters 0-50:
class ['a] c () = object
method f = (x : 'a)
end..
Error: The type of this class,
class ['a] c :
unit -> object constraint 'a = '_weak1 list ref method f : 'a end,
contains type variables that cannot be generalized
# Characters 21-53:
type 'a c = <f : 'a c; g : 'a d>
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: In the definition of d, type int c should be 'a c
# type 'a c = < f : 'a c; g : 'a d >
and 'a d = < f : 'a c >
# type 'a c = < f : 'a c >
and 'a d = < f : int c >
# Characters 22-39:
and 'a t = 'a t u;; (* fails since 4.04 *)
^^^^^^^^^^^^^^^^^
Error: The definition of t contains a cycle:
'a t u
# Characters 15-32:
and 'a t = 'a t u;;
^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
# type 'a u = 'a
# Characters 0-18:
type t = t u * t u;;
^^^^^^^^^^^^^^^^^^
Error: The type abbreviation t is cyclic
# type t = < x : 'a > as 'a
# type 'a u = 'a
# - : t -> t u -> bool = <fun>
# - : t -> t u -> bool = <fun>
# module M :
sig
class ['a, 'b] c :
int ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
end
# module M' :
sig
class virtual ['a, 'b] c :
int ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
end
# class ['a, 'b] d :
unit ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
# class ['a, 'b] e :
unit ->
'b ->
object
constraint 'a = int -> bool
val x : float list
val y : 'b
method f : 'a -> unit
method g : 'b
end
# - : string = "a"
# - : int = 10
# - : float = 7.1
# # - : bool = true
# module M : sig class ['a] c : unit -> object method f : 'a -> unit end end
# module M' : sig class ['a] c : unit -> object method f : 'a -> unit end end
# - : ('a #M.c as 'b) -> 'b = <fun>
# - : ('a #M'.c as 'b) -> 'b = <fun>
# class ['a] c : 'a #c -> object end
# class ['a] c : 'a #c -> object end
# class c : unit -> object method f : int end
and d : unit -> object method f : int end
# class e : unit -> object method f : int end
# - : int = 2
# Characters 30-34:
class c () = object val x = - true val y = -. () end;;
^^^^
Error: This expression has type bool but an expression was expected of type
int
# class c : unit -> object method f : int method g : int method h : int end
# class d : unit -> object method h : int method i : int method j : int end
# class e :
unit ->
object
method f : int
method g : int
method h : int
method i : int
method j : int
end
# val e : e = <obj>
# - : int * int * int * int * int = (1, 3, 2, 2, 3)
# class c : 'a -> object val a : 'a val x : int val y : int val z : int end
# class d : 'a -> object val b : 'a val t : int val u : int val z : int end
# Characters 42-45:
inherit c 5
^^^
Warning 13: the following instance variables are overridden by the class c :
x
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Characters 52-53:
val y = 3
^
Warning 13: the instance variable y is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Characters 80-83:
inherit d 7
^^^
Warning 13: the following instance variables are overridden by the class d :
t z
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
Characters 90-91:
val u = 3
^
Warning 13: the instance variable u is overridden.
The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)
class e :
unit ->
object
val a : int
val b : int
val t : int
val u : int
val x : int
val y : int
val z : int
method a : int
method b : int
method t : int
method u : int
method x : int
method y : int
method z : int
end
# val e : e = <obj>
# - : int * int * int * int * int * int * int = (1, 3, 2, 2, 3, 5, 7)
# class c :
int ->
int -> object val x : int val y : int method x : int method y : int end
# class d :
int ->
int -> object val x : int val y : int method x : int method y : int end
# - : int * int = (1, 2)
# - : int * int = (1, 2)
# class ['a] c : 'a -> object end
# - : 'a -> 'a c = <fun>
# * * * * * * * * * * * * * * * * * * * * * module M : sig class c : unit -> object method xc : int end end
# class d : unit -> object val x : int method xc : int method xd : int end
# - : int * int = (1, 2)
# Characters 1-154:
class virtual ['a] matrix (sz, init : int * 'a) = object
val m = Array.make_matrix sz sz init
method add (mtx : 'a matrix) = (mtx#m.(0).(0) : 'a)
end..
Error: The abbreviation 'a matrix expands to type < add : 'a matrix -> 'a >
but is used with type < m : 'a array array; .. >
# class c : unit -> object method m : c end
# - : c = <obj>
# module M : sig class c : unit -> object method m : c end end
# - : M.c = <obj>
# type uu = A of int | B of (< leq : 'a > as 'a)
# class virtual c : unit -> object ('a) method virtual m : 'a end
# module S : sig val f : (#c as 'a) -> 'a end
# Characters 12-43:
............struct
let f (x : #c) = x
end......
Error: Signature mismatch:
Modules do not match:
sig val f : (#c as 'a) -> 'a end
is not included in
sig val f : #c -> #c end
Values do not match:
val f : (#c as 'a) -> 'a
is not included in
val f : #c -> #c
# Characters 38-39:
module M = struct type t = int class t () = object end end;;
^
Error: Multiple definition of the type name t.
Names must be unique in a given structure or signature.
# - : < m : (< m : 'a > as 'b) -> 'b as 'a; .. > -> 'b = <fun>
# Characters 10-39:
fun x -> (x : int -> bool :> 'a -> 'a);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type int -> bool is not a subtype of int -> int
Type bool is not a subtype of int
# Characters 9-40:
fun x -> (x : int -> bool :> int -> int);;
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Type int -> bool is not a subtype of int -> int
Type bool is not a subtype of int
# - : < > -> < > = <fun>
# - : < .. > -> < > = <fun>
# val x : '_weak2 list ref = {contents = []}
# module F : functor (X : sig end) -> sig type t = int end
# - : < m : int > list ref = {contents = []}
# type 'a t
# Characters 9-19:
fun (x : 'a t as 'a) -> ();;
^^^^^^^^^^
Error: This alias is bound to type 'a t but is used as an instance of type 'a
The type variable 'a occurs inside 'a t
# Characters 19-20:
fun (x : 'a t) -> (x : 'a); ();;
^
Error: This expression has type 'a t but an expression was expected of type
'a
The type variable 'a occurs inside 'a t
# type 'a t = < x : 'a >
# - : ('a t as 'a) -> unit = <fun>
# Characters 18-26:
fun (x : 'a t) -> (x : 'a); ();;
^^^^^^^^
Warning 10: this expression should have type unit.
- : ('a t as 'a) t -> unit = <fun>
# class ['a] c :
unit ->
object constraint 'a = (< .. > as 'b) -> unit method m : 'b -> unit end
# class ['a] c :
unit ->
object constraint 'a = unit -> (< .. > as 'b) method m : 'a -> 'b end
# class c : unit -> object method private m : int method n : int end
# class d :
unit -> object method private m : int method n : int method o : int end
# - : int * int = (1, 1)
# class c : unit -> object method m : int end
# val r : int ref = {contents = 0}
# val id : < .. > -> int = <fun>
# - : unit = ()
# - : int = 1
# - : int = 2
# - : int * int * int = (3, 4, 5)
# - : int * int * int * int * int = (6, 7, 8, 33, 33)
# - : int * int * int * int * int * int * int = (9, 10, 10, 11, 11, 33, 33)
# Characters 42-69:
class a = let _ = new b in object end
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed
# Characters 11-38:
class a = let _ = new a in object end;;
^^^^^^^^^^^^^^^^^^^^^^^^^^^
Error: This kind of recursive class expression is not allowed
#

4
testsuite/tests/typing-objects/open_in_classes.compilers.reference
View File

@ -1,4 +0,0 @@
module M : sig type t = int val x : int end
class c : object method f : M.t end
class type ct = object method f : M.t end

11
testsuite/tests/typing-objects/open_in_classes.ml
View File

@ -1,5 +1,5 @@
(* TEST
* toplevel
* expect
*)
module M = struct
@ -7,15 +7,24 @@ module M = struct
let x = 42
end
;;
[%%expect{|
module M : sig type t = int val x : int end
|}]
class c =
let open M in
object
method f : t = x
end
;;
[%%expect{|
class c : object method f : M.t end
|}]
class type ct =
let open M in
object
method f : t
end
;;
[%%expect{|
class type ct = object method f : M.t end
|}]

5
testsuite/tests/typing-objects/pr5545.compilers.reference
View File

@ -1,5 +0,0 @@
type foo = int
class o : object method x : foo method y : int end
class o : object method x : foo method y : int end
class o : object method x : int method y : foo end

14
testsuite/tests/typing-objects/pr5545.ml
View File

@ -1,14 +1,20 @@
(* TEST
* toplevel
* expect
*)
type foo = int;;
[%%expect{|
type foo = int
|}]
class o =
object(this)
method x : foo = 10
method y : int = this # x
end;;
[%%expect{|
class o : object method x : foo method y : int end
|}]
class o =
@ -16,6 +22,9 @@ class o =
method x : foo = 10
method y = (this # x : int)
end;;
[%%expect{|
class o : object method x : foo method y : int end
|}]
@ -24,3 +33,6 @@ class o =
method x : int = (10 : int)
method y = (this # x : foo)
end;;
[%%expect{|
class o : object method x : int method y : foo end
|}]

6
testsuite/tests/typing-objects/pr5545.ml.principal.reference
View File

@ -1,6 +0,0 @@
# type foo = int
# class o : object method x : foo method y : int end
# class o : object method x : foo method y : int end
# class o : object method x : int method y : foo end
#

17
testsuite/tests/typing-objects/pr5619_bad.compilers.reference
View File

@ -1,17 +0,0 @@
class type foo_t = object method foo : string end
type 'a name = Foo : foo_t name | Int : int name
class foo :
object method cast : foo_t name -> < foo : string > method foo : string end
Characters 22-176:
..object(self)
method foo = "foo"
method cast: type a. a name -> a =
function
Foo -> (self :> foo_t)
| _ -> raise Exit
end
Error: The class type
object method cast : 'a name -> 'a method foo : string end
is not matched by the class type foo_t
The public method cast cannot be hidden

25
testsuite/tests/typing-objects/pr5619_bad.ml
View File

@ -1,5 +1,5 @@
(* TEST
* toplevel
* expect
*)
class type foo_t =
@ -12,6 +12,11 @@ type 'a name =
| Int: int name
;;
[%%expect{|
class type foo_t = object method foo : string end
type 'a name = Foo : foo_t name | Int : int name
|}]
class foo =
object(self)
method foo = "foo"
@ -20,6 +25,10 @@ class foo =
Foo -> (self :> <foo : string>)
end
;;
[%%expect{|
class foo :
object method cast : foo_t name -> < foo : string > method foo : string end
|}]
class foo: foo_t =
object(self)
@ -30,3 +39,17 @@ class foo: foo_t =
| _ -> raise Exit
end
;;
[%%expect{|
Line _, characters 2-156:
..object(self)
method foo = "foo"
method cast: type a. a name -> a =
function
Foo -> (self :> foo_t)
| _ -> raise Exit
end
Error: The class type
object method cast : 'a name -> 'a method foo : string end
is not matched by the class type foo_t
The public method cast cannot be hidden
|}]

18
testsuite/tests/typing-objects/pr5619_bad.ml.principal.reference
View File

@ -1,18 +0,0 @@
# class type foo_t = object method foo : string end
type 'a name = Foo : foo_t name | Int : int name
# class foo :
object method cast : foo_t name -> < foo : string > method foo : string end
# Characters 22-176:
..object(self)
method foo = "foo"
method cast: type a. a name -> a =
function
Foo -> (self :> foo_t)
| _ -> raise Exit
end
Error: The class type
object method cast : 'a name -> 'a method foo : string end
is not matched by the class type foo_t
The public method cast cannot be hidden
#

6
testsuite/tests/typing-objects/pr5858.compilers.reference
View File

@ -1,6 +0,0 @@
class type c = object end
Characters 29-30:
module type S = sig class c: c end;;
^
Error: The class type c is not yet completely defined

12
testsuite/tests/typing-objects/pr5858.ml
View File

@ -1,6 +1,16 @@
(* TEST
* toplevel
* expect
*)
class type c = object end;;
[%%expect{|
class type c = object end
|}]
module type S = sig class c: c end;;
[%%expect{|
Line _, characters 29-30:
module type S = sig class c: c end;;
^
Error: The class type c is not yet completely defined
|}]

7
testsuite/tests/typing-objects/pr6123_bad.compilers.reference
View File

@ -1,7 +0,0 @@
Characters 279-283:
let args = List.map (fun ty -> new argument(self, ty)) args_ty in
^^^^
Error: This expression has type < arguments : 'a; .. >
but an expression was expected of type 'b
Self type cannot escape its class

10
testsuite/tests/typing-objects/pr6123_bad.ml
View File

@ -1,5 +1,5 @@
(* TEST
* toplevel
* expect
*)
class virtual name =
@ -25,3 +25,11 @@ object
inherit name
end
;;
[%%expect{|
Line _, characters 50-54:
let args = List.map (fun ty -> new argument(self, ty)) args_ty in
^^^^
Error: This expression has type < arguments : 'a; .. >
but an expression was expected of type 'b
Self type cannot escape its class
|}]

8
testsuite/tests/typing-objects/pr6123_bad.ml.principal.reference
View File

@ -1,8 +0,0 @@
# Characters 253-257:
let args = List.map (fun ty -> new argument(self, ty)) args_ty in
^^^^
Error: This expression has type < arguments : 'a; .. >
but an expression was expected of type 'b
Self type cannot escape its class
#

5
testsuite/tests/typing-objects/pr6383.compilers.reference
View File

@ -1,5 +0,0 @@
Characters 37-42:
let f (x: #M.foo) = 0;;
^^^^^
Error: Unbound module M

8
testsuite/tests/typing-objects/pr6383.ml
View File

@ -1,5 +1,11 @@
(* TEST
* toplevel
* expect
*)
let f (x: #M.foo) = 0;;
[%%expect{|
Line _, characters 11-16:
let f (x: #M.foo) = 0;;
^^^^^
Error: Unbound module M
|}];;

9
testsuite/tests/typing-objects/pr6907_bad.compilers.reference
View File

@ -1,9 +0,0 @@
class type ['e] t = object ('a) method update : 'e -> 'a end
Characters 23-48:
class base : 'e -> ['e] t
^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Some type variables are unbound in this type:
class base : 'e -> ['e] t
The method update has type 'e -> < update : 'a; .. > as 'a where 'e
is unbound

14
testsuite/tests/typing-objects/pr6907_bad.ml
View File

@ -1,11 +1,23 @@
(* TEST
* toplevel
* expect
*)
class type ['e] t = object('s)
method update : 'e -> 's
end;;
[%%expect{|
class type ['e] t = object ('a) method update : 'e -> 'a end
|}];;
module type S = sig
class base : 'e -> ['e] t
end;;
[%%expect{|
Line _, characters 2-27:
class base : 'e -> ['e] t
^^^^^^^^^^^^^^^^^^^^^^^^^
Error: Some type variables are unbound in this type:
class base : 'e -> ['e] t
The method update has type 'e -> < update : 'a; .. > as 'a where 'e
is unbound
|}];;

3
testsuite/tests/typing-objects/pr7711_ok.compilers.reference
View File

@ -1,3 +0,0 @@
type 'a r = 'a constraint 'a = < w : int -> int; .. >
class type virtual ct = object method virtual w : int -> int end

8
testsuite/tests/typing-objects/pr7711_ok.ml
View File

@ -1,9 +1,15 @@
(* TEST
* toplevel
* expect
*)
type 'a r = <w: int -> int; .. > as 'a;;
[%%expect{|
type 'a r = 'a constraint 'a = < w : int -> int; .. >
|}];;
class type virtual ct = object('self)
constraint 'self = 'not_self r
end;;
[%%expect{|
class type virtual ct = object method virtual w : int -> int end
|}];;