X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=ad1853d8e07c75eec98e3756352d7e9e47c6362a;hb=140791a0479787eaca83bea2355c15b65259a823;hp=928780cef199b59dcfcac64ec68dc86c1c3e0806;hpb=d4073df37f0540f148b1b702a32ffba8c646a0ca;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 928780c..ad1853d 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -446,8 +446,8 @@ (declare (notinline mapcar)) (1+ (mapcar #'print '(1 2 3))))))) -;; bug found by Paul Dietz: (SETF AREF) for bit vectors with constant -;; index was effectless +;;; bug found by Paul Dietz: (SETF AREF) for bit vectors with constant +;;; index was effectless (let ((f (compile nil '(lambda (a v) (declare (type simple-bit-vector a) (type bit v)) (declare (optimize (speed 3) (safety 0))) @@ -463,7 +463,7 @@ (declare (type (simple-array (simple-string 3) (5)) x)) (aref (aref x 0) 0)))) -;; compiler failure +;;; compiler failure (let ((f (compile nil '(lambda (x) (typep x '(not (member 0d0))))))) (assert (funcall f 1d0))) @@ -471,3 +471,222 @@ (declare (double-float x)) (let ((y (* x pi))) (atan y y)))) + +;;; bogus optimization of BIT-NOT +(multiple-value-bind (result x) + (eval '(let ((x (eval #*1001))) + (declare (optimize (speed 2) (space 3)) + (type (bit-vector) x)) + (values (bit-not x nil) x))) + (assert (equal x #*1001)) + (assert (equal result #*0110))) + +;;; the VECTOR type in CONCATENATE/MERGE/MAKE-SEQUENCE means (VECTOR T). +(handler-bind ((sb-ext:compiler-note #'error)) + (assert (equalp (funcall + (compile + nil + '(lambda () + (let ((x (make-sequence 'vector 10 :initial-element 'a))) + (setf (aref x 4) 'b) + x)))) + #(a a a a b a a a a a)))) + +;;; this is not a check for a bug, but rather a test of compiler +;;; quality +(dolist (type '((integer 0 *) ; upper bound + (real (-1) *) + float ; class + (real * (-10)) ; lower bound + )) + (assert (nth-value + 1 (compile nil + `(lambda (n) + (declare (optimize (speed 3) (compilation-speed 0))) + (loop for i from 1 to (the (integer -17 10) n) by 2 + collect (when (> (random 10) 5) + (the ,type (- i 11))))))))) + +;;; bug 278b +;;; +;;; We suppose that INTEGER arithmetic cannot be efficient, and the +;;; compiler has an optimized VOP for +; so this code should cause an +;;; efficiency note. +(assert (eq (block nil + (handler-case + (compile nil '(lambda (i) + (declare (optimize speed)) + (declare (type integer i)) + (+ i 2))) + (sb-ext:compiler-note (c) (return :good)))) + :good)) + +;;; bug 277: IGNORE/IGNORABLE declarations should be acceptable for +;;; symbol macros +(assert (not (nth-value 1 (compile nil '(lambda (u v) + (symbol-macrolet ((x u) + (y v)) + (declare (ignore x) + (ignorable y)) + (list u v))))))) + +;;; bug reported by Paul Dietz: wrong optimizer for (EXPT ... 0) +(loop for (x type) in + '((14 integer) + (14 rational) + (-14/3 (rational -8 11)) + (3s0 short-float) + (4f0 single-float) + (5d0 double-float) + (6l0 long-float) + (14 real) + (13/2 real) + (2s0 real) + (2d0 real) + (#c(-3 4) (complex fixnum)) + (#c(-3 4) (complex rational)) + (#c(-3/7 4) (complex rational)) + (#c(2s0 3s0) (complex short-float)) + (#c(2f0 3f0) (complex single-float)) + (#c(2d0 3d0) (complex double-float)) + (#c(2l0 3l0) (complex long-float)) + (#c(2d0 3s0) (complex float)) + (#c(2 3f0) (complex real)) + (#c(2 3d0) (complex real)) + (#c(-3/7 4) (complex real)) + (#c(-3/7 4) complex) + (#c(2 3l0) complex)) + do (dolist (zero '(0 0s0 0f0 0d0 0l0)) + (dolist (real-zero (list zero (- zero))) + (let* ((src `(lambda (x) (expt (the ,type x) ,real-zero))) + (fun (compile nil src)) + (result (1+ (funcall (eval #'*) x real-zero)))) + (assert (eql result (funcall fun x))))))) + +;;; (SIGNED-BYTE 1) [ returned from the logxor derive-type optimizer ] +;;; wasn't recognized as a good type specifier. +(let ((fun (lambda (x y) + (declare (type (integer -1 0) x y) (optimize speed)) + (logxor x y)))) + (assert (= (funcall fun 0 0) 0)) + (assert (= (funcall fun 0 -1) -1)) + (assert (= (funcall fun -1 -1) 0))) + +;;; from PFD's torture test, triggering a bug in our effective address +;;; treatment. +(compile + nil + `(lambda (a b) + (declare (type (integer 8 22337) b)) + (logandc2 + (logandc2 + (* (logandc1 (max -29303 b) 4) b) + (abs (logorc1 (+ (logandc1 -11 b) 2607688420) -31153924))) + (logeqv (max a 0) b)))) + +;;; Alpha floating point modes weren't being reset after an exception, +;;; leading to an exception on the second compile, below. +(compile nil '(lambda (x y) (declare (type (double-float 0.0d0) x y)) (/ x y))) +(handler-case (/ 1.0 0.0) + ;; provoke an exception + (arithmetic-error ())) +(compile nil '(lambda (x y) (declare (type (double-float 0.0d0) x y)) (/ x y))) + +;;; bug reported by Paul Dietz: component last block does not have +;;; start ctran +(compile nil + '(lambda () + (declare (notinline + logand) + (optimize (speed 0))) + (LOGAND + (BLOCK B5 + (FLET ((%F1 () + (RETURN-FROM B5 -220))) + (LET ((V7 (%F1))) + (+ 359749 35728422)))) + -24076))) + +;;; bug 294 reported by Paul Dietz: miscompilation of REM and MOD +(assert (= (funcall (compile nil `(lambda (b) + (declare (optimize (speed 3)) + (type (integer 2 152044363) b)) + (rem b (min -16 0)))) + 108251912) + 8)) + +(assert (= (funcall (compile nil `(lambda (c) + (declare (optimize (speed 3)) + (type (integer 23062188 149459656) c)) + (mod c (min -2 0)))) + 95019853) + -1)) + +;;; bug reported by Paul Dietz: block splitting inside FLUSH-DEAD-CODE +(compile nil + '(LAMBDA (A B C) + (BLOCK B6 + (LOGEQV (REM C -6758) + (REM B (MAX 44 (RETURN-FROM B6 A))))))) + +(compile nil '(lambda () + (block nil + (flet ((foo (x y) (if (> x y) (print x) (print y)))) + (foo 1 2) + (bar) + (foo (return 14) 2))))) + +;;; bug in Alpha backend: not enough sanity checking of arguments to +;;; instructions +(assert (= (funcall (compile nil + '(lambda (x) + (declare (fixnum x)) + (ash x -257))) + 1024) + 0)) + +;;; bug found by WHN and pfdietz: compiler failure while referencing +;;; an entry point inside a deleted lambda +(compile nil '(lambda () + (let (r3533) + (flet ((bbfn () + (setf r3533 + (progn + (flet ((truly (fn bbd) + (let (r3534) + (let ((p3537 nil)) + (unwind-protect + (multiple-value-prog1 + (progn + (setf r3534 + (progn + (bubf bbd t) + (flet ((c-3536 () + (funcall fn))) + (cdec #'c-3536 + (vector bbd)))))) + (setf p3537 t)) + (unless p3537 + (error "j")))) + r3534)) + (c (pd) (pdc pd))) + (let ((a (smock a)) + (b (smock b)) + (b (smock c))))))))) + (wum #'bbfn "hc3" (list))) + r3533))) +(compile nil '(lambda () (flet ((%f () (unwind-protect nil))) nil))) + +;;; the strength reduction of constant multiplication used (before +;;; sbcl-0.8.4.x) to lie to the compiler. This meant that, under +;;; certain circumstances, the compiler would derive that a perfectly +;;; reasonable multiplication never returned, causing chaos. Fixed by +;;; explicitly doing modular arithmetic, and relying on the backends +;;; being smart. +(assert (= (funcall + (compile nil + '(lambda (x) + (declare (type (integer 178956970 178956970) x) + (optimize speed)) + (* x 24))) + 178956970) + 4294967280))