From: Alexey D. <ade...@us...> - 2004-05-01 11:22:49
|
Update of /cvsroot/sbcl/sbcl/tests In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv14118/tests Modified Files: compiler.pure.lisp Log Message: 0.8.10.3: * Merge with stack-analysis-branch. Index: compiler.pure.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/tests/compiler.pure.lisp,v retrieving revision 1.88 retrieving revision 1.89 diff -u -d -r1.88 -r1.89 --- compiler.pure.lisp 19 Apr 2004 13:46:27 -0000 1.88 +++ compiler.pure.lisp 1 May 2004 11:22:39 -0000 1.89 @@ -1033,6 +1033,8 @@ 215067723) 13739018)) + +;;;; 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)) + + ;;; MISC.275 (assert (zerop |