From: Christophe R. <cr...@us...> - 2002-04-19 17:38:36
|
Update of /cvsroot/sbcl/sbcl/tests In directory usw-pr-cvs1:/tmp/cvs-serv24288/tests Modified Files: type.impure.lisp Log Message: 0.7.2.18: Merge CSR "More type hacking" sbcl-devel 2002-04-10 ... don't include request for explanation (as WHN explained) ... do cross-type of complex complex specifiers conservatively Index: type.impure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/type.impure.lisp,v retrieving revision 1.18 retrieving revision 1.19 diff -C2 -d -r1.18 -r1.19 *** type.impure.lisp 8 Apr 2002 22:00:39 -0000 1.18 --- type.impure.lisp 19 Apr 2002 16:27:21 -0000 1.19 *************** *** 10,23 **** `(assert (equal '(t t) (multiple-value-list ,expr)))) (let ((types '(character integer fixnum (integer 0 10) single-float (single-float -1.0 1.0) (single-float 0.1) (real 4 8) (real -1 7) (real 2 11) (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3) ! ;; FIXME: When bug 91 is fixed, add these to the list: ! ;; (INTEGER -1 1) ! ;; UNSIGNED-BYTE ! ;; (RATIONAL -1 7) (RATIONAL -2 4) ! ;; RATIO ))) (dolist (i types) --- 10,28 ---- `(assert (equal '(t t) (multiple-value-list ,expr)))) + (defmacro assert-t-t-or-uncertain (expr) + `(assert (let ((list (multiple-value-list ,expr))) + (or (equal '(nil nil) list) + (equal '(t t) list))))) + (let ((types '(character integer fixnum (integer 0 10) single-float (single-float -1.0 1.0) (single-float 0.1) (real 4 8) (real -1 7) (real 2 11) + null symbol keyword (member #\a #\b #\c) (member 1 #\a) (member 3.0 3.3) ! (integer -1 1) ! unsigned-byte ! (rational -1 7) (rational -2 4) ! ratio ))) (dolist (i types) *************** *** 171,174 **** --- 176,186 ---- ;;; NIL, T (indicating surety) for the following: (assert-nil-nil (subtypep '(satisfies some-undefined-fun) 'nil)) + + ;;; It turns out that, as of sbcl-0.7.2, we require to be able to + ;;; detect this to compile src/compiler/node.lisp (and in particular, + ;;; the definition of the component structure). Since it's a sensible + ;;; thing to want anyway, let's test for it here: + (assert-t-t (subtypep '(or some-undefined-type (member :no-ir2-yet :dead)) + '(or some-undefined-type (member :no-ir2-yet :dead)))) ;;;; Douglas Thomas Crosher rewrote the CMU CL type test system to |