X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler-1.impure-cload.lisp;h=cdad366eff6237ee7af6bbc63936f99a9032fcde;hb=0957d59ccfaf3db9aaf79a7f4909a40ea0ca0dcd;hp=a873e694bf928ce79e92c22da029628d61b77c4c;hpb=7317109e5f23cb96289e104df95b0ef10985d2c0;p=sbcl.git

diff --git a/tests/compiler-1.impure-cload.lisp b/tests/compiler-1.impure-cload.lisp
index a873e69..cdad366 100644
--- a/tests/compiler-1.impure-cload.lisp
+++ b/tests/compiler-1.impure-cload.lisp
@@ -115,5 +115,62 @@
                  nil)
                '(13 nil)))
 
+;;; bug 221: sbcl 0.7.9.13 failed to compile the following function
+(declaim (ftype (function (fixnum) (values package boolean)) bug221-f1))
+(declaim (ftype (function (t) (values package boolean)) bug221-f2))
+(defun bug221 (b x)
+  (funcall (if b #'bug221-f1 #'bug221-f2) x))
+
+;;; bug 166: compiler failure
+(defstruct bug166s)
+(defmethod permanentize ((uustk bug166s))
+  (flet ((frob (hash-table test-for-deletion)
+           )
+         (obj-entry.stale? (oe)
+           (destructuring-bind (key . datum) oe
+             (declare (type simple-vector key))
+             (deny0 (void? datum))
+             (some #'stale? key))))
+    (declare (inline frob obj-entry.stale?))
+    (frob (uustk.args-hash->obj-alist uustk)
+          #'obj-entry.stale?)
+    (frob (uustk.hash->memoized-objs-list uustk)
+          #'objs.stale?))
+  (call-next-method))
+
+;;; bugs 115, 226: compiler failure in lifetime analysis
+(defun bug115-1 ()
+  (declare (optimize (speed 2) (debug 3)))
+  (flet ((m1 ()
+           (unwind-protect nil)))
+    (if (catch nil)
+        (m1)
+        (m1))))
+
+(defun bug115-2 ()
+  (declare (optimize (speed 2) (debug 3)))
+  (flet ((m1 ()
+           (bar (if (foo) 1 2))
+           (let ((x (foo)))
+             (bar x (list x)))))
+    (if (catch nil)
+        (m1)
+        (m1))))
+
+(defun bug226 ()
+  (declare (optimize (speed 0) (safety 3) (debug 3)))
+  (flet ((safe-format (stream string &rest r)
+           (unless (ignore-errors (progn
+                                    (apply #'format stream string r)
+                                    t))
+             (format stream "~&foo ~S" string))))
+    (cond
+      ((eq my-result :ERROR)
+       (cond
+         ((ignore-errors (typep condition result))
+          (safe-format t "~&bar ~S" result))
+         (t
+          (safe-format t "~&baz ~S (~A) ~S" condition condition result)))))))
+
 (sb-ext:quit :unix-status 104) ; success