0.8.16.2: TYPE-ERROR for ERROR

[sbcl.git] / tests / compiler.pure.lisp

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index adafaf8..cd528ed 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1461,6 +1461,14 @@
        (TAGBODY (THE INTEGER (CATCH 'CT4 (LOGORC1 C -15950))) 1)
        B))))
 
+(compile nil
+  '(lambda (buffer i end)
+    (declare (optimize (debug 3)))
+    (loop (when (not (eql 0 end)) (return)))
+    (let ((s (make-string end)))
+      (setf (schar s i) (schar buffer i))
+      s)))
+
 ;;; check that constant string prefix and suffix don't cause the
 ;;; compiler to emit code deletion notes.
 (handler-bind ((sb-ext:code-deletion-note #'error))
@@ -1473,3 +1481,17 @@
   (compile nil '(lambda (s x)
                  (pprint-logical-block (s x :suffix ">")
                    (print x s)))))
+
+;;; MISC.427: loop analysis requires complete DFO structure
+(assert (eql 17 (funcall
+  (compile
+   nil
+   '(lambda (a)
+     (declare (notinline list reduce logior))
+     (declare (optimize (safety 2) (compilation-speed 1)
+               (speed 3) (space 2) (debug 2)))
+     (logior
+      (let* ((v5 (reduce #'+ (list 0 a))))
+        (declare (dynamic-extent v5))
+        v5))))
+    17)))