blob: 980c519c8124df17b8a024385bdce26c106437f7 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
(* TEST
no-flat-float-array;
expect;
*)
(* This file copies the tests from test_flat.ml,
but is only tested when -no-flat-float-array
is set, and thus all types are unboxable.
We kept the comments on why each test should fail,
to make it easier to compare the two files,
but the test in this file should all pass,
as shown in the expected outputs.
*)
(* should fail *)
type 'a abs;;
type t16 = A : _ abs -> t16 [@@ocaml.unboxed];;
[%%expect{|
type 'a abs
type t16 = A : 'a abs -> t16 [@@unboxed]
|}];;
(* should fail (the existential _ still occurs in an abstract type) *)
type t18 = A : _ list abs -> t18 [@@ocaml.unboxed];;
[%%expect{|
type t18 = A : 'a list abs -> t18 [@@unboxed]
|}];;
(* regression test for PR#7511 (wrong determination of unboxability for GADTs)
*)
type 'a s = S : 'a -> 'a s [@@unboxed];;
type t = T : _ s -> t [@@unboxed];;
[%%expect{|
type 'a s = S : 'a -> 'a s [@@unboxed]
type t = T : 'a s -> t [@@unboxed]
|}];;
(* regression test for GPR#1133 (follow-up to PR#7511) *)
type 'a s = S : 'a -> 'a option s [@@unboxed];;
type t = T : _ s -> t [@@unboxed];;
[%%expect{|
type 'a s = S : 'a -> 'a option s [@@unboxed]
type t = T : 'a s -> t [@@unboxed]
|}];;
(* Another test for GPR#1133: abstract types *)
module M : sig
type 'a r constraint 'a = unit -> 'b
val inj : 'b -> (unit -> 'b) r
end = struct
type 'a r = 'b constraint 'a = unit -> 'b
let inj x = x
end;;
[%%expect{|
module M :
sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
|}];;
(* reject *)
type t = T : (unit -> _) M.r -> t [@@unboxed];;
[%%expect{|
type t = T : (unit -> 'a) M.r -> t [@@unboxed]
|}];;
type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed];;
[%%expect{|
type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
|}];;
(* reject *)
type t = T : _ s -> t [@@unboxed];;
[%%expect{|
type t = T : 'a s -> t [@@unboxed]
|}];;
(* accept *)
type 'a t = T : 'a s -> 'a t [@@unboxed];;
[%%expect{|
type 'a t = T : 'a s -> 'a t [@@unboxed]
|}];;
(* Another corner case from GPR#1133 *)
type _ s = S : 'a t -> _ s [@@unboxed]
and _ t = T : 'a -> 'a s t
;;
[%%expect{|
type _ s = S : 'a t -> 'b s [@@unboxed]
and _ t = T : 'a -> 'a s t
|}];;
(* regression test for PR#7511 (wrong determination of unboxability for GADTs)
*)
type 'a s = S : 'a -> 'a s [@@unboxed];;
type t = T : _ s -> t [@@unboxed];;
[%%expect{|
type 'a s = S : 'a -> 'a s [@@unboxed]
type t = T : 'a s -> t [@@unboxed]
|}];;
(* regression test for GPR#1133 (follow-up to PR#7511) *)
type 'a s = S : 'a -> 'a option s [@@unboxed];;
type t = T : _ s -> t [@@unboxed];;
[%%expect{|
type 'a s = S : 'a -> 'a option s [@@unboxed]
type t = T : 'a s -> t [@@unboxed]
|}];;
(* Another test for GPR#1133: abstract types *)
module M : sig
type 'a r constraint 'a = unit -> 'b
val inj : 'b -> (unit -> 'b) r
end = struct
type 'a r = 'b constraint 'a = unit -> 'b
let inj x = x
end;;
[%%expect{|
module M :
sig type 'a r constraint 'a = unit -> 'b val inj : 'b -> (unit -> 'b) r end
|}];;
(* reject *)
type t = T : (unit -> _) M.r -> t [@@unboxed];;
[%%expect{|
type t = T : (unit -> 'a) M.r -> t [@@unboxed]
|}];;
type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed];;
[%%expect{|
type 'a s = S : (unit -> 'a) M.r -> 'a option s [@@unboxed]
|}];;
(* reject *)
type t = T : _ s -> t [@@unboxed];;
[%%expect{|
type t = T : 'a s -> t [@@unboxed]
|}];;
(* accept *)
type 'a t = T : 'a s -> 'a t [@@unboxed];;
[%%expect{|
type 'a t = T : 'a s -> 'a t [@@unboxed]
|}];;
(* Another corner case from GPR#1133 *)
type _ s = S : 'a t -> _ s [@@unboxed]
and _ t = T : 'a -> 'a s t
;;
[%%expect{|
type _ s = S : 'a t -> 'b s [@@unboxed]
and _ t = T : 'a -> 'a s t
|}];;
|
