28 |
t t)) |
t t)) |
29 |
,@(loop for parent in (adjoin 'condition parents) |
,@(loop for parent in (adjoin 'condition parents) |
30 |
collect |
collect |
31 |
|
`(deftest ,(make-def-cond-name name "IS-SUBTYPE-OF-2/" parent) |
32 |
|
(check-all-subtypep ',name-symbol ',parent) |
33 |
|
nil)) |
34 |
|
,@(loop for parent in (adjoin 'condition parents) |
35 |
|
collect |
36 |
`(deftest ,(make-def-cond-name name |
`(deftest ,(make-def-cond-name name |
37 |
"IS-NOT-SUPERTYPE-OF/" parent) |
"IS-NOT-SUPERTYPE-OF/" parent) |
38 |
(subtypep* ',parent ',name-symbol) |
(subtypep* ',parent ',name-symbol) |
43 |
(let ((c (make-condition ',name-symbol))) |
(let ((c (make-condition ',name-symbol))) |
44 |
(notnot-mv (typep c ',parent))) |
(notnot-mv (typep c ',parent))) |
45 |
t)) |
t)) |
46 |
|
,@(loop for parent in (adjoin 'condition parents) |
47 |
|
collect |
48 |
|
`(deftest ,(make-def-cond-name name "IS-SUBCLASS-OF/" parent) |
49 |
|
(subtypep* (find-class ',name-symbol) |
50 |
|
(find-class ',parent)) |
51 |
|
t t)) |
52 |
|
,@(loop for parent in (adjoin 'condition parents) |
53 |
|
collect |
54 |
|
`(deftest ,(make-def-cond-name name |
55 |
|
"IS-NOT-SUPERCLASS-OF/" parent) |
56 |
|
(subtypep* (find-class ',parent) |
57 |
|
(find-class ',name-symbol)) |
58 |
|
nil t)) |
59 |
|
,@(loop for parent in (adjoin 'condition parents) |
60 |
|
collect |
61 |
|
`(deftest ,(make-def-cond-name name "IS-A-MEMBER-OF-CLASS/" |
62 |
|
parent) |
63 |
|
(let ((c (make-condition ',name-symbol))) |
64 |
|
(notnot-mv (typep c (find-class ',parent)))) |
65 |
|
t)) |
66 |
))) |
))) |
67 |
|
|