| ... |
... |
@@ -244,61 +244,71 @@ |
|
244
|
244
|
(define-test standard-char.intersection-character-both-orderings
|
|
245
|
245
|
(:tag :issues)
|
|
246
|
246
|
;; Standard-char intersect character = standard-char, regardless of argument order.
|
|
247
|
|
- (assert-equality #'kernel::type=
|
|
248
|
|
- (kernel::specifier-type 'standard-char)
|
|
249
|
|
- (kernel::type-intersection (kernel::specifier-type 'standard-char)
|
|
250
|
|
- (kernel::specifier-type 'character)))
|
|
251
|
|
- (assert-equality #'kernel::type=
|
|
252
|
|
- (kernel::specifier-type 'standard-char)
|
|
253
|
|
- (kernel::type-intersection (kernel::specifier-type 'character)
|
|
254
|
|
- (kernel::specifier-type 'standard-char))))
|
|
|
247
|
+ (assert-equal (values t t)
|
|
|
248
|
+ (kernel::type=
|
|
|
249
|
+ (kernel::specifier-type 'standard-char)
|
|
|
250
|
+ (kernel::type-intersection (kernel::specifier-type 'standard-char)
|
|
|
251
|
+ (kernel::specifier-type 'character))))
|
|
|
252
|
+ (assert-equal (values t t)
|
|
|
253
|
+ (kernel::type=
|
|
|
254
|
+ (kernel::specifier-type 'standard-char)
|
|
|
255
|
+ (kernel::type-intersection (kernel::specifier-type 'character)
|
|
|
256
|
+ (kernel::specifier-type 'standard-char)))))
|
|
255
|
257
|
|
|
256
|
258
|
(define-test standard-char.intersection-disjoint-both-orderings
|
|
257
|
259
|
(:tag :issues)
|
|
258
|
|
- (assert-equality #'kernel::type=
|
|
259
|
|
- kernel::*empty-type*
|
|
260
|
|
- (kernel::type-intersection (kernel::specifier-type 'standard-char)
|
|
261
|
|
- (kernel::specifier-type 'integer)))
|
|
262
|
|
- (assert-equality #'kernel::type=
|
|
263
|
|
- kernel::*empty-type*
|
|
264
|
|
- (kernel::type-intersection (kernel::specifier-type 'integer)
|
|
265
|
|
- (kernel::specifier-type 'standard-char))))
|
|
|
260
|
+ (assert-equal (values t t)
|
|
|
261
|
+ (kernel::type=
|
|
|
262
|
+ kernel::*empty-type*
|
|
|
263
|
+ (kernel::type-intersection (kernel::specifier-type 'standard-char)
|
|
|
264
|
+ (kernel::specifier-type 'integer))))
|
|
|
265
|
+ (assert-equal (values t t)
|
|
|
266
|
+ (kernel::type=
|
|
|
267
|
+ kernel::*empty-type*
|
|
|
268
|
+ (kernel::type-intersection (kernel::specifier-type 'integer)
|
|
|
269
|
+ (kernel::specifier-type 'standard-char)))))
|
|
266
|
270
|
|
|
267
|
271
|
(define-test standard-char.intersection-member-both-orderings
|
|
268
|
272
|
(:tag :issues)
|
|
269
|
273
|
;; Filter member-type to standard chars only.
|
|
270
|
|
- (assert-equality #'kernel::type=
|
|
271
|
|
- (kernel::specifier-type '(member #\a #\b))
|
|
272
|
|
- (kernel::type-intersection (kernel::specifier-type 'standard-char)
|
|
273
|
|
- (kernel::specifier-type '(member #\a #\Tab #\b))))
|
|
274
|
|
- (assert-equality #'kernel::type=
|
|
275
|
|
- (kernel::specifier-type '(member #\a #\b))
|
|
276
|
|
- (kernel::type-intersection (kernel::specifier-type '(member #\a #\Tab #\b))
|
|
277
|
|
- (kernel::specifier-type 'standard-char))))
|
|
|
274
|
+ (assert-equal (values t t)
|
|
|
275
|
+ (kernel::type=
|
|
|
276
|
+ (kernel::specifier-type '(member #\a #\b))
|
|
|
277
|
+ (kernel::type-intersection (kernel::specifier-type 'standard-char)
|
|
|
278
|
+ (kernel::specifier-type '(member #\a #\Tab #\b)))))
|
|
|
279
|
+ (assert-equal (values t t)
|
|
|
280
|
+ (kernel::type=
|
|
|
281
|
+ (kernel::specifier-type '(member #\a #\b))
|
|
|
282
|
+ (kernel::type-intersection (kernel::specifier-type '(member #\a #\Tab #\b))
|
|
|
283
|
+ (kernel::specifier-type 'standard-char)))))
|
|
278
|
284
|
|
|
279
|
285
|
(define-test standard-char.union-character-both-orderings
|
|
280
|
286
|
(:tag :issues)
|
|
281
|
287
|
;; Standard-char union character = character.
|
|
282
|
|
- (assert-equality #'kernel::type=
|
|
283
|
|
- (kernel::specifier-type 'character)
|
|
284
|
|
- (kernel::type-union (kernel::specifier-type 'standard-char)
|
|
285
|
|
- (kernel::specifier-type 'character)))
|
|
286
|
|
- (assert-equality #'kernel::type=
|
|
287
|
|
- (kernel::specifier-type 'character)
|
|
288
|
|
- (kernel::type-union (kernel::specifier-type 'character)
|
|
289
|
|
- (kernel::specifier-type 'standard-char))))
|
|
|
288
|
+ (assert-equal (values t t)
|
|
|
289
|
+ (kernel::type=
|
|
|
290
|
+ (kernel::specifier-type 'character)
|
|
|
291
|
+ (kernel::type-union (kernel::specifier-type 'standard-char)
|
|
|
292
|
+ (kernel::specifier-type 'character))))
|
|
|
293
|
+ (assert-equal (values t t)
|
|
|
294
|
+ (kernel::type=
|
|
|
295
|
+ (kernel::specifier-type 'character)
|
|
|
296
|
+ (kernel::type-union (kernel::specifier-type 'character)
|
|
|
297
|
+ (kernel::specifier-type 'standard-char)))))
|
|
290
|
298
|
|
|
291
|
299
|
(define-test standard-char.union-member-of-standard-both-orderings
|
|
292
|
300
|
(:tag :issues)
|
|
293
|
301
|
;; Standard-char absorbs all-standard member-type.
|
|
294
|
|
- (assert-equality #'kernel::type=
|
|
295
|
|
- (kernel::specifier-type 'standard-char)
|
|
296
|
|
- (kernel::type-union (kernel::specifier-type 'standard-char)
|
|
297
|
|
- (kernel::specifier-type '(member #\a #\b))))
|
|
298
|
|
- (assert-equality #'kernel::type=
|
|
299
|
|
- (kernel::specifier-type 'standard-char)
|
|
300
|
|
- (kernel::type-union (kernel::specifier-type '(member #\a #\b))
|
|
301
|
|
- (kernel::specifier-type 'standard-char))))
|
|
|
302
|
+ (assert-equal (values t t)
|
|
|
303
|
+ (kernel::type=
|
|
|
304
|
+ (kernel::specifier-type 'standard-char)
|
|
|
305
|
+ (kernel::type-union (kernel::specifier-type 'standard-char)
|
|
|
306
|
+ (kernel::specifier-type '(member #\a #\b)))))
|
|
|
307
|
+ (assert-equal (values t t)
|
|
|
308
|
+ (kernel::type=
|
|
|
309
|
+ (kernel::specifier-type 'standard-char)
|
|
|
310
|
+ (kernel::type-union (kernel::specifier-type '(member #\a #\b))
|
|
|
311
|
+ (kernel::specifier-type 'standard-char)))))
|
|
302
|
312
|
|
|
303
|
313
|
(define-test standard-char.union-disjoint-stays-symbolic-both-orderings
|
|
304
|
314
|
(:tag :issues)
|
| ... |
... |
@@ -308,7 +318,8 @@ |
|
308
|
318
|
(r2 (kernel::specifier-type '(or standard-char boolean))))
|
|
309
|
319
|
(assert-true (kernel::union-type-p r1))
|
|
310
|
320
|
(assert-true (kernel::union-type-p r2))
|
|
311
|
|
- (assert-equality #'kernel::type= r1 r2)
|
|
|
321
|
+ (assert-equal (values t t)
|
|
|
322
|
+ (kernel::type= r1 r2))
|
|
312
|
323
|
;; Neither should contain a member-type with both characters
|
|
313
|
324
|
;; and non-characters.
|
|
314
|
325
|
(dolist (m (kernel::union-type-types r1))
|
| ... |
... |
@@ -319,18 +330,20 @@ |
|
319
|
330
|
|
|
320
|
331
|
(defun assert-commutative-union (type-a-spec type-b-spec)
|
|
321
|
332
|
"Assert that union(A, B) and union(B, A) produce type= results."
|
|
322
|
|
- (assert-equality #'kernel::type=
|
|
323
|
|
- (kernel::type-union (kernel::specifier-type type-a-spec)
|
|
324
|
|
- (kernel::specifier-type type-b-spec))
|
|
325
|
|
- (kernel::type-union (kernel::specifier-type type-b-spec)
|
|
326
|
|
- (kernel::specifier-type type-a-spec))))
|
|
|
333
|
+ (assert-equal (values t t)
|
|
|
334
|
+ (kernel::type=
|
|
|
335
|
+ (kernel::type-union (kernel::specifier-type type-a-spec)
|
|
|
336
|
+ (kernel::specifier-type type-b-spec))
|
|
|
337
|
+ (kernel::type-union (kernel::specifier-type type-b-spec)
|
|
|
338
|
+ (kernel::specifier-type type-a-spec)))))
|
|
327
|
339
|
|
|
328
|
340
|
(defun assert-commutative-intersection (type-a-spec type-b-spec)
|
|
329
|
|
- (assert-equality #'kernel::type=
|
|
330
|
|
- (kernel::type-intersection (kernel::specifier-type type-a-spec)
|
|
331
|
|
- (kernel::specifier-type type-b-spec))
|
|
332
|
|
- (kernel::type-intersection (kernel::specifier-type type-b-spec)
|
|
333
|
|
- (kernel::specifier-type type-a-spec))))
|
|
|
341
|
+ (assert-equal (values t t)
|
|
|
342
|
+ (kernel::type=
|
|
|
343
|
+ (kernel::type-intersection (kernel::specifier-type type-a-spec)
|
|
|
344
|
+ (kernel::specifier-type type-b-spec))
|
|
|
345
|
+ (kernel::type-intersection (kernel::specifier-type type-b-spec)
|
|
|
346
|
+ (kernel::specifier-type type-a-spec)))))
|
|
334
|
347
|
|
|
335
|
348
|
(define-test standard-char.commutativity
|
|
336
|
349
|
(:tag :issues)
|