103 |
|
|
104 |
;;; Check that the disjoint types really are disjoint |
;;; Check that the disjoint types really are disjoint |
105 |
|
|
|
(deftest types-7 |
|
|
(loop |
|
|
for tp in *disjoint-types-list* sum |
|
|
(loop for tp2 in *disjoint-types-list* count |
|
|
(and (not (eqt tp tp2)) |
|
|
(subtypep* tp tp2)))) |
|
|
0) |
|
|
|
|
|
(deftest types-7a |
|
|
(loop |
|
|
for tp in *disjoint-types-list* sum |
|
|
(loop for tp2 in *disjoint-types-list* count |
|
|
(and (not (eqt tp tp2)) |
|
|
(multiple-value-bind (sub valid) |
|
|
(subtypep `(not ,tp) `(not ,tp2)) |
|
|
(and sub valid))))) |
|
|
0) |
|
|
|
|
106 |
(deftest types-7b |
(deftest types-7b |
107 |
(loop for e on *disjoint-types-list* |
(loop for e on *disjoint-types-list* |
108 |
for tp1 = (first e) |
for tp1 = (first e) |
109 |
append |
append |
110 |
(loop for tp2 in (rest e) |
(loop for tp2 in (rest e) |
111 |
for result = (check-disjointness tp1 tp2) |
append (classes-are-disjoint tp1 tp2))) |
|
append result)) |
|
112 |
nil) |
nil) |
113 |
|
|
114 |
(deftest types-7c |
(deftest types-7c |
116 |
for list1 = (first e) |
for list1 = (first e) |
117 |
append |
append |
118 |
(loop for tp1 in list1 append |
(loop for tp1 in list1 append |
119 |
(loop for list2 in (rest e) append |
(loop for list2 in (rest e) |
120 |
|
append |
121 |
(loop for tp2 in list2 append |
(loop for tp2 in list2 append |
122 |
(check-disjointness tp1 tp2))))) |
(classes-are-disjoint tp1 tp2))))) |
123 |
nil) |
nil) |
124 |
|
|
125 |
(deftest types-8 |
(deftest types-8 |
126 |
(loop |
(loop |
132 |
t))) |
t))) |
133 |
0) |
0) |
134 |
|
|
135 |
(declaim (special *type-list* |
(declaim (special *type-list* *supertype-table*)) |
|
*supertype-table*)) |
|
136 |
|
|
137 |
;;; |
;;; |
138 |
;;; TYPES-9 checks the transitivity of SUBTYPEP on pairs of types |
;;; TYPES-9 checks the transitivity of SUBTYPEP on pairs of types |
173 |
collect (list e types)) |
collect (list e types)) |
174 |
nil) |
nil) |
175 |
|
|
176 |
|
|
177 |
(deftest integer-and-ratio-are-disjoint |
(deftest integer-and-ratio-are-disjoint |
178 |
(check-disjointness 'integer 'ratio) |
(classes-are-disjoint 'integer 'ratio) |
179 |
nil) |
nil) |
180 |
|
|
181 |
(deftest bignum-and-ratio-are-disjoint |
(deftest bignum-and-ratio-are-disjoint |
182 |
(check-disjointness 'bignum 'ratio) |
(classes-are-disjoint 'bignum 'ratio) |
183 |
nil) |
nil) |
184 |
|
|
185 |
(deftest bignum-and-fixnum-are-disjoint |
(deftest bignum-and-fixnum-are-disjoint |
186 |
(check-disjointness 'bignum 'fixnum) |
(classes-are-disjoint 'bignum 'fixnum) |
187 |
nil) |
nil) |
188 |
|
|
189 |
(deftest fixnum-and-ratio-are-disjoint |
(deftest fixnum-and-ratio-are-disjoint |
190 |
(check-disjointness 'fixnum 'ratio) |
(classes-are-disjoint 'fixnum 'ratio) |
191 |
nil) |
nil) |
192 |
|
|
193 |
(deftest byte8-and-ratio-are-disjoint |
(deftest byte8-and-ratio-are-disjoint |
194 |
(check-disjointness '(unsigned-byte 8) 'ratio) |
(classes-are-disjoint '(unsigned-byte 8) 'ratio) |
195 |
nil) |
nil) |
196 |
|
|
197 |
(deftest bit-and-ratio-are-disjoint |
(deftest bit-and-ratio-are-disjoint |
198 |
(check-disjointness 'bit 'ratio) |
(classes-are-disjoint 'bit 'ratio) |
199 |
nil) |
nil) |
200 |
|
|
201 |
(deftest integer-and-float-are-disjoint |
(deftest integer-and-float-are-disjoint |
202 |
(check-disjointness 'integer 'float) |
(classes-are-disjoint 'integer 'float) |
203 |
nil) |
nil) |
204 |
|
|
205 |
(deftest ratio-and-float-are-disjoint |
(deftest ratio-and-float-are-disjoint |
206 |
(check-disjointness 'ratio 'float) |
(classes-are-disjoint 'ratio 'float) |
207 |
nil) |
nil) |
208 |
|
|
209 |
(deftest complex-and-float-are-disjoint |
(deftest complex-and-float-are-disjoint |
210 |
(check-disjointness 'complex 'float) |
(classes-are-disjoint 'complex 'float) |
211 |
nil) |
nil) |
212 |
|
|
213 |
(deftest integer-subranges-are-disjoint |
(deftest integer-subranges-are-disjoint |
214 |
(check-disjointness '(integer 0 (10)) '(integer 10 (20))) |
(classes-are-disjoint '(integer 0 (10)) '(integer 10 (20))) |
215 |
nil) |
nil) |
216 |
|
|
217 |
(deftest keyword-and-null-are-disjoint |
(deftest keyword-and-null-are-disjoint |
218 |
(check-disjointness 'keyword 'null) |
(classes-are-disjoint 'keyword 'null) |
219 |
nil) |
nil) |
220 |
|
|
221 |
(deftest keyword-and-boolean-are-disjoint |
(deftest keyword-and-boolean-are-disjoint |
222 |
(check-disjointness 'keyword 'boolean) |
(classes-are-disjoint 'keyword 'boolean) |
223 |
nil) |
nil) |
224 |
|
|
225 |
|
|
226 |
|
;;; Check that all class names in CL that name standard-classes or |
227 |
|
;;; structure-classes are subtypes of standard-object and structure-object, |
228 |
|
;;; respectively |
229 |
|
|
230 |
|
(deftest all-standard-classes-are-subtypes-of-standard-object |
231 |
|
(loop for sym being the external-symbols of "COMMON-LISP" |
232 |
|
for class = (find-class sym nil) |
233 |
|
when (and class |
234 |
|
(typep class 'standard-class) |
235 |
|
(or (not (subtypep sym 'standard-object)) |
236 |
|
(not (subtypep class 'standard-object)))) |
237 |
|
collect sym) |
238 |
|
nil) |
239 |
|
|
240 |
|
(deftest all-structure-classes-are-subtypes-of-structure-object |
241 |
|
(loop for sym being the external-symbols of "COMMON-LISP" |
242 |
|
for class = (find-class sym nil) |
243 |
|
when (and class |
244 |
|
(typep class 'structure-class) |
245 |
|
(or (not (subtypep sym 'structure-object)) |
246 |
|
(not (subtypep class 'structure-object)))) |
247 |
|
collect sym) |
248 |
|
nil) |
249 |
|
|
250 |
|
|
251 |
|
|
252 |
|
|
253 |
|
|
257 |
|
|
258 |
(deftype even-array (&optional type size) |
(deftype even-array (&optional type size) |
259 |
`(and (array ,type ,size) |
`(and (array ,type ,size) |
260 |
(satisfies even-size-p))) |
(satisfies even-size-p))) |
261 |
|
|
262 |
(deftest deftype-1 |
(deftest deftype-1 |
263 |
(typep 1 '(even-array integer (10))) |
(typep 1 '(even-array integer (10))) |
264 |
nil) |
nil) |
265 |
|
|
266 |
(deftest deftype-2 |
(deftest deftype-2 |
267 |
(typep nil '(even-array t (*))) |
(typep nil '(even-array t (*))) |
268 |
nil) |
nil) |
269 |
|
|
270 |
(deftest deftype-3 |
(deftest deftype-3 |