Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv20373/tests
Modified Files:
compiler.impure.lisp
Log Message:
0.9.15.44: fix bug 368: intersection of array types
* TYPE-INTERSECTION of arrays preserves the specialized type when
appropriate -- even if the intersection of the expressed types is
empty.
* Delete bug 217 -- has been fixed, is in the test-suite.
* Note about bug 235.
* Not more *USE-IMPLEMENTATION-TYPES*, behave always as if it was T.
Index: compiler.impure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/compiler.impure.lisp,v
retrieving revision 1.72
retrieving revision 1.73
diff -u -d -r1.72 -r1.73
--- compiler.impure.lisp 16 Aug 2006 19:05:46 -0000 1.72
+++ compiler.impure.lisp 21 Aug 2006 17:54:38 -0000 1.73
@@ -1327,4 +1327,32 @@
(funcall x))))
nil (constantly 42)))))
+;;; bug 368: array type intersections in the compiler
+(defstruct e368)
+(defstruct i368)
+(defstruct g368
+ (i368s (make-array 0 :fill-pointer t) :type (or (vector i368) null)))
+(defstruct s368
+ (g368 (error "missing :G368") :type g368 :read-only t))
+(declaim (ftype (function (fixnum (vector i368) e368) t) r368))
+(declaim (ftype (function (fixnum (vector e368)) t) h368))
+(defparameter *h368-was-called-p* nil)
+(defun nsu (vertices e368)
+ (let ((i368s (g368-i368s (make-g368))))
+ (let ((fuis (r368 0 i368s e368)))
+ (format t "~&FUIS=~S~%" fuis)
+ (or fuis (h368 0 i368s)))))
+(defun r368 (w x y)
+ (declare (ignore w x y))
+ nil)
+(defun h368 (w x)
+ (declare (ignore w x))
+ (setf *h368-was-called-p* t)
+ (make-s368 :g368 (make-g368)))
+(let ((nsu (nsu #() (make-e368))))
+ (format t "~&NSU returned ~S~%" nsu)
+ (format t "~&*H368-WAS-CALLED-P*=~S~%" *h368-was-called-p*)
+ (assert (s368-p nsu))
+ (assert *h368-was-called-p*))
+
;;; success
|