161 |
(types-9a-body) |
(types-9a-body) |
162 |
0) |
0) |
163 |
|
|
|
;;; |
|
|
;;; Check that disjointness of types in *disjoint-types-list* |
|
|
;;; is respected by all the elements of *universe* |
|
|
;;; |
|
|
(deftest universe-elements-in-at-most-one-disjoint-type |
|
|
(loop for e in *universe* |
|
|
for types = (remove-if-not #'(lambda (x) (typep e x)) |
|
|
*disjoint-types-list*) |
|
|
when (> (length types) 1) |
|
|
collect (list e types)) |
|
|
nil) |
|
|
|
|
|
;;; Union of a type with its complement is universal |
|
|
|
|
|
(deftest type-or-not-type-is-everything |
|
|
(loop for l in *disjoint-types-list2* |
|
|
append |
|
|
(loop |
|
|
for type in l |
|
|
append (check-subtypep t `(or ,type (not ,type)) t) |
|
|
append (check-subtypep t `(or (not ,type) ,type) t))) |
|
|
nil) |
|
|
|
|
|
(defclass tac-1-class () (a b c)) |
|
|
(defclass tac-1a-class (tac-1-class) (d e)) |
|
|
(defclass tac-1b-class (tac-1-class) (f g)) |
|
|
|
|
|
(deftest user-class-disjointness |
|
|
(loop for l in *disjoint-types-list2* |
|
|
append |
|
|
(loop |
|
|
for type in l |
|
|
append (classes-are-disjoint type 'tac-1-class))) |
|
|
nil) |
|
|
|
|
|
(deftest user-class-disjointness-2 |
|
|
(check-disjointness 'tac-1a-class 'tac-1b-class) |
|
|
nil) |
|
|
|
|
|
(defstruct tac-2-struct a b c) |
|
|
(defstruct (tac-2a-struct (:include tac-2-struct)) d e) |
|
|
(defstruct (tac-2b-struct (:include tac-2-struct)) f g) |
|
|
|
|
|
(deftest user-struct-disjointness |
|
|
(loop for l in *disjoint-types-list2* |
|
|
append |
|
|
(loop |
|
|
for type in l |
|
|
append (check-disjointness type 'tac-2-struct))) |
|
|
nil) |
|
|
|
|
|
(deftest user-struct-disjointness-2 |
|
|
(check-disjointness 'tac-2a-struct 'tac-2b-struct) |
|
|
nil) |
|
|
|
|
|
(deftest integer-and-ratio-are-disjoint |
|
|
(classes-are-disjoint 'integer 'ratio) |
|
|
nil) |
|
|
|
|
|
(deftest bignum-and-ratio-are-disjoint |
|
|
(classes-are-disjoint 'bignum 'ratio) |
|
|
nil) |
|
|
|
|
|
(deftest bignum-and-fixnum-are-disjoint |
|
|
(classes-are-disjoint 'bignum 'fixnum) |
|
|
nil) |
|
164 |
|
|
|
(deftest fixnum-and-ratio-are-disjoint |
|
|
(classes-are-disjoint 'fixnum 'ratio) |
|
|
nil) |
|
|
|
|
|
(deftest byte8-and-ratio-are-disjoint |
|
|
(classes-are-disjoint '(unsigned-byte 8) 'ratio) |
|
|
nil) |
|
|
|
|
|
(deftest bit-and-ratio-are-disjoint |
|
|
(classes-are-disjoint 'bit 'ratio) |
|
|
nil) |
|
|
|
|
|
(deftest integer-and-float-are-disjoint |
|
|
(classes-are-disjoint 'integer 'float) |
|
|
nil) |
|
|
|
|
|
(deftest ratio-and-float-are-disjoint |
|
|
(classes-are-disjoint 'ratio 'float) |
|
|
nil) |
|
|
|
|
|
(deftest complex-and-float-are-disjoint |
|
|
(classes-are-disjoint 'complex 'float) |
|
|
nil) |
|
|
|
|
|
(deftest integer-subranges-are-disjoint |
|
|
(classes-are-disjoint '(integer 0 (10)) '(integer 10 (20))) |
|
|
nil) |
|
|
|
|
|
(deftest keyword-and-null-are-disjoint |
|
|
(classes-are-disjoint 'keyword 'null) |
|
|
nil) |
|
|
|
|
|
(deftest keyword-and-boolean-are-disjoint |
|
|
(classes-are-disjoint 'keyword 'boolean) |
|
|
nil) |
|
165 |
|
|
166 |
|
|
167 |
;;; Check that all class names in CL that name standard-classes or |
;;; Check that all class names in CL that name standard-classes or |
336 |
(notnot-mv (typep env (type-of env))))) |
(notnot-mv (typep env (type-of env))))) |
337 |
(%foo)) |
(%foo)) |
338 |
t) |
t) |
|
|
|