X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler-1.impure-cload.lisp;h=8f89da44e9983ecc4dc7e79ac5c851b7176e04aa;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=a608dc8ac0a2373fc1b5c52a0ff579df3a43cf5a;hpb=2489ac3021325890a98886110ab3055fa990a850;p=sbcl.git

diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp
index a608dc8..8f89da4 100644
--- a/tests/compiler-1.impure-cload.lisp
+++ b/tests/compiler-1.impure-cload.lisp
@@ -103,12 +103,14 @@
 ;;; bug 31 turned out to be a manifestation of non-ANSI array type
 ;;; handling, fixed by CSR in sbcl-0.7.3.8.
 (defun array-element-type-handling (x)
+  (declare (optimize safety))
   (declare (type (vector cons) x))
   (when (consp (aref x 0))
     (aref x 0)))
-(assert (eq (array-element-type-handling
-	     (make-array 3 :element-type t :initial-element 0))
-	    nil))
+(assert (raises-error?
+	 (array-element-type-handling
+	  (make-array 3 :element-type t :initial-element 0))
+	 type-error))
 
 ;;; bug 220: type check inserted after all arguments in MV-CALL caused
 ;;; failure of stack analysis
@@ -202,4 +204,35 @@
 (assert (raises-error? (bug231b 0 1.5) type-error))
 (assert (raises-error? (bug231b 0 0) type-error))
 
+;;; A bug appeared in flaky7_branch. Python got lost in unconverting
+;;; embedded tail calls during let-convertion.
+(defun bug239 (bit-array-2 &optional result-bit-array)
+  (declare (type (array bit) bit-array-2)
+           (type (or (array bit) (member t nil)) result-bit-array))
+  (unless (simple-bit-vector-p bit-array-2)
+    (multiple-value-call
+        (lambda (data1 start1)
+          (multiple-value-call
+              (lambda (data2 start2)
+                (multiple-value-call
+                    (lambda (data3 start3)
+                      (declare (ignore start3))
+                      (print (list data1 data2)))
+                  (values 0 0)))
+            (values bit-array-2 0)))
+      (values 444 0))))
+(assert (equal (bug239 (make-array 4 :element-type 'bit
+                                   :adjustable t
+                                   :initial-element 0)
+                       nil)
+               '(444 #*0000)))
+
+(defstruct some-structure a)
+(eval-when (:compile-toplevel)
+  ;; in the big CLASS reorganization in pre8, this would fail with
+  ;; SOME-STRUCTURE-A is not FBOUNDP.  Fixed in 0.pre8.64
+  (find-class 'some-structure nil))
+(eval-when (:load-toplevel)
+  (assert (typep (find-class 'some-structure) 'class)))
+
 (sb-ext:quit :unix-status 104) ; success