X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=5066830533e4c02844f2c3538968d7e51572e116;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=c1ad3e338e76a1ebd3c8ec6f07ffac8d39734fab;hpb=d7ca32c95549ea9dd6c68b813c4ac1f1d66984e1;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index c1ad3e3..5066830 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -409,3 +409,85 @@ (list (the fixnum (the (real 0) (eval v)))))))) (assert (raises-error? (funcall f 0.1) type-error)) (assert (raises-error? (funcall f -1) type-error))) + +;;; the implicit block does not enclose lambda list +(let ((forms '((defmacro #1=#:foo (&optional (x (return-from #1#)))) + #+nil(macrolet ((#2=#:foo (&optional (x (return-from #2#)))))) + (define-compiler-macro #3=#:foo (&optional (x (return-from #3#)))) + (deftype #4=#:foo (&optional (x (return-from #4#)))) + (define-setf-expander #5=#:foo (&optional (x (return-from #5#)))) + (defsetf #6=#:foo (&optional (x (return-from #6#))) ())))) + (dolist (form forms) + (assert (nth-value 2 (compile nil `(lambda () ,form)))))) + +(assert (nth-value 2 (compile nil + '(lambda () + (svref (make-array '(8 9) :adjustable t) 1))))) + +;;; CHAR= did not check types of its arguments (reported by Adam Warner) +(raises-error? (funcall (compile nil '(lambda (x y z) (char= x y z))) + #\a #\b nil) + type-error) +(raises-error? (funcall (compile nil + '(lambda (x y z) + (declare (optimize (speed 3) (safety 3))) + (char/= x y z))) + nil #\a #\a) + type-error) + +;;; Compiler lost return type of MAPCAR and friends +(dolist (fun '(mapcar mapc maplist mapl)) + (assert (nth-value 2 (compile nil + `(lambda (x) + (1+ (,fun #'print x))))))) + +(assert (nth-value 2 (compile nil + '(lambda () + (declare (notinline mapcar)) + (1+ (mapcar #'print '(1 2 3))))))) + +;;; 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))) + (setf (aref a 0) v) + a)))) + (let ((y (make-array 2 :element-type 'bit :initial-element 0))) + (assert (equal y #*00)) + (funcall f y 1) + (assert (equal y #*10)))) + +(handler-bind ((sb-ext:compiler-note #'error)) + (compile nil '(lambda (x) + (declare (type (simple-array (simple-string 3) (5)) x)) + (aref (aref x 0) 0)))) + +;;; compiler failure +(let ((f (compile nil '(lambda (x) (typep x '(not (member 0d0))))))) + (assert (funcall f 1d0))) + +(compile nil '(lambda (x) + (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))))