X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fcompiler.pure.lisp;h=fe4bd644e7d1e1625b58b71b56e3da65908c479c;hb=e2574c9090a19634f1f903a9f0c229960edfd7b6;hp=e081b4ec86a311a0036a61f172c16cbfc12dacfe;hpb=5a2c8811f297b21b5e4142ce29d2c7981cbb2697;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index e081b4e..fe4bd64 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -4179,3 +4179,60 @@ (declare (optimize speed) (type (and fixnum a) x)) x))) + +(with-test (:name :bug-959687) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda (x) + (case x + (t + :its-a-t) + (otherwise + :somethign-else)))) + (assert (and warn fail)) + (assert (not (ignore-errors (funcall fun t))))) + (multiple-value-bind (fun warn fail) + (compile nil `(lambda (x) + (case x + (otherwise + :its-an-otherwise) + (t + :somethign-else)))) + (assert (and warn fail)) + (assert (not (ignore-errors (funcall fun t)))))) + +(with-test (:name :bug-924276) + (assert (eq :style-warning + (handler-case + (compile nil `(lambda (a) + (cons a (symbol-macrolet ((b 1)) + (declare (ignorable a)) + :c)))) + (style-warning () + :style-warning))))) + +(with-test (:name :bug-974406) + (let ((fun32 (compile nil `(lambda (x) + (declare (optimize speed (safety 0))) + (declare (type (integer 53 86) x)) + (logand (+ x 1032791128) 11007078467)))) + (fun64 (compile nil `(lambda (x) + (declare (optimize speed (safety 0))) + (declare (type (integer 53 86) x)) + (logand (+ x 1152921504606846975) + 38046409652025950207))))) + (assert (= (funcall fun32 61) 268574721)) + (assert (= (funcall fun64 61) 60))) + (let (result) + (do ((width 5 (1+ width))) + ((= width 130)) + (dotimes (extra 4) + (let ((fun (compile nil `(lambda (x) + (declare (optimize speed (safety 0))) + (declare (type (integer 1 16) x)) + (logand + (+ x ,(1- (ash 1 width))) + ,(logior (ash 1 (+ width 1 extra)) + (1- (ash 1 width)))))))) + (unless (= (funcall fun 16) (logand 15 (1- (ash 1 width)))) + (push (cons width extra) result))))) + (assert (null result))))