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

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

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

revision 1.34 by pfdietz, Fri Jan 31 03:25:03 2003 UTC revision 1.35 by pfdietz, Fri Jan 31 12:35:23 2003 UTC
# Line 148  Results: ~A~%" expected-number form n re Line 148  Results: ~A~%" expected-number form n re
148             (check-subtypep type2 `(not ,type1) t)             (check-subtypep type2 `(not ,type1) t)
149             (check-subtypep `(and ,type1 ,type2) nil t)             (check-subtypep `(and ,type1 ,type2) nil t)
150             (check-subtypep `(and ,type2 ,type1) nil t)             (check-subtypep `(and ,type2 ,type1) nil t)
151               (check-subtypep `(and ,type1 (not ,type2)) type1 t)
152               (check-subtypep `(and (not ,type2) ,type1) type1 t)
153               (check-subtypep `(and ,type2 (not ,type1)) type2 t)
154               (check-subtypep `(and (not ,type1) ,type2) type2 t)
155               (check-subtypep type1 `(or ,type1 (not ,type2)) t)
156               (check-subtypep type1 `(or (not ,type2) ,type1) t)
157               (check-subtypep type2 `(or ,type2 (not ,type1)) t)
158               (check-subtypep type2 `(or (not ,type1) ,type2) t)
159             )))             )))
160    
161  (defun check-subtypep (type1 type2 is-sub &optional should-be-valid)  (defun check-subtypep (type1 type2 is-sub &optional should-be-valid)
# Line 621  the condition to go uncaught if it canno Line 629  the condition to go uncaught if it canno
629    
630  (defun types-6-body ()  (defun types-6-body ()
631    (loop    (loop
632        for p in *subtype-table* count        for p in *subtype-table*
633        (let ((tp (car p)))        for tp = (car p)
634          (when (and (not (member tp '(sequence cons list t)))        append
635                     (not (subtypep* tp 'atom)))        (and (not (member tp '(sequence cons list t)))
636            (format t "~%Problem!  Did not find to be an atomic type: ~S" tp)             (let ((message (check-subtypep tp 'atom t t)))
637            t))))               (if message (list message))))))
638    
639  (defparameter *type-list* nil)  (defparameter *type-list* nil)
640  (defparameter *supertype-table* nil)  (defparameter *supertype-table* nil)

Legend:
Removed from v.1.34  
changed lines
  Added in v.1.35

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