/[gcl]/gcl/ansi-tests/define-condition-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/define-condition-aux.lsp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.1 by pfdietz, Sun Mar 9 12:20:49 2003 UTC revision 1.2 by pfdietz, Tue Mar 11 03:29:07 2003 UTC
# Line 28  Line 28 
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)
# Line 38  Line 43 
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    

Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26