CVS: sbcl/tests type.impure.lisp,1.18,1.19

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