Commit dc08fd54 authored by pfdietz's avatar pfdietz
Browse files

Added more default define-condition tests.

parent ed62f885
......@@ -26,6 +26,11 @@
`(deftest ,(make-def-cond-name name "IS-SUBTYPE-OF/" parent)
(subtypep* ',name-symbol ',parent)
t t))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name "IS-SUBTYPE-OF-2/" parent)
(check-all-subtypep ',name-symbol ',parent)
nil))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name
......@@ -38,5 +43,25 @@
(let ((c (make-condition ',name-symbol)))
(notnot-mv (typep c ',parent)))
t))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name "IS-SUBCLASS-OF/" parent)
(subtypep* (find-class ',name-symbol)
(find-class ',parent))
t t))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name
"IS-NOT-SUPERCLASS-OF/" parent)
(subtypep* (find-class ',parent)
(find-class ',name-symbol))
nil t))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name "IS-A-MEMBER-OF-CLASS/"
parent)
(let ((c (make-condition ',name-symbol)))
(notnot-mv (typep c (find-class ',parent))))
t))
)))
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment