0.8.10.3:

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

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 4413058..56811da 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1033,6 +1033,8 @@
      215067723)
     13739018))
 
+\f
+;;;; Bugs in stack analysis
 ;;; bug 299 (reported by PFD)
 (assert
  (equal (funcall
@@ -1044,6 +1046,43 @@
               (if (eval t) (eval '(values :a :b :c)) nil)
               (catch 'foo (throw 'foo (values :x :y)))))))
         '(:a :b :c :x :y)))
+;;; bug 298 (= MISC.183)
+(assert (zerop (funcall
+                (compile
+                 nil
+                 '(lambda (a b c)
+                   (declare (type (integer -368154 377964) a))
+                   (declare (type (integer 5044 14959) b))
+                   (declare (type (integer -184859815 -8066427) c))
+                   (declare (ignorable a b c))
+                   (declare (optimize (speed 3)))
+                   (declare (optimize (safety 1)))
+                   (declare (optimize (debug 1)))
+                   (block b7
+                     (flet ((%f3 (f3-1 f3-2 f3-3) 0))
+                       (apply #'%f3 0 (catch 'foo (return-from b7 (%f3 0 b c))) c nil)))))
+                0 6000 -9000000)))
+(assert (equal (eval '(let () (apply #'list 1 (list (catch 'a (throw 'a (block b 2)))))))
+               '(1 2)))
+(let ((f (compile
+          nil
+          '(lambda (x)
+            (block foo
+              (multiple-value-call #'list
+                :a
+                (block bar
+                  (return-from foo
+                    (multiple-value-call #'list
+                      :b
+                      (block quux
+                        (return-from bar
+                          (catch 'baz
+                            (if x
+                                (return-from quux 1)
+                                (throw 'baz 2))))))))))))))
+  (assert (equal (funcall f t) '(:b 1)))
+  (assert (equal (funcall f nil) '(:a 2))))
+
 ;;; MISC.185
 (assert (equal
          (funcall
@@ -1094,6 +1133,55 @@
                 :good
                 (values result1 result2))))
          :good))
+
+;;; MISC.290
+(assert (zerop
+         (funcall
+          (compile
+           nil
+           '(lambda ()
+             (declare
+              (optimize (speed 3) (space 3) (safety 1)
+               (debug 2) (compilation-speed 0)))
+             (apply (constantly 0) (catch 'ct2 0) 0 (catch 'ct2 0) nil))))))
+
+;;; MISC.292
+(assert (zerop (funcall
+                (compile
+                 nil
+                 '(lambda (a b)
+                   (declare (optimize (speed 2) (space 0) (safety 3) (debug 1)
+                             (compilation-speed 2)))
+                   (apply (constantly 0)
+                    a
+                    0
+                    (catch 'ct6
+                      (apply (constantly 0)
+                             0
+                             0
+                             (let* ((v1
+                                     (let ((*s7* 0))
+                                       b)))
+                               0)
+                             0
+                             nil))
+                    0
+                    nil)))
+                1 2)))
+
+;;; misc.295
+(assert (eql
+         (funcall
+          (compile
+           nil
+           '(lambda ()
+             (declare (optimize (speed 1) (space 0) (safety 0) (debug 0)))
+             (multiple-value-prog1
+                 (the integer (catch 'ct8 (catch 'ct7 15867134)))
+               (catch 'ct1 (throw 'ct1 0))))))
+         15867134))
+
+\f
 ;;; MISC.275
 (assert
  (zerop