X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=d4608173a4348dc9fd8edb6464217da3858a4340;hb=175f390470effba8f6c5c8bf58125a3792cf5ad0;hp=69fcd3cf9d13ccde4f026cedfee87772a94bca24;hpb=71766d9db05e93567cb7e829abfc675c3cb895c9;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index 69fcd3c..d460817 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -2201,3 +2201,89 @@ y) (integer-length x))))) warned-p)) + +;; Dead / in safe code +(with-test (:name :safe-dead-/) + (assert (eq :error + (handler-case + (funcall (compile nil + '(lambda (x y) + (declare (optimize (safety 3))) + (/ x y) + (+ x y))) + 1 + 0) + (division-by-zero () + :error))))) + +;;; Dead unbound variable (bug 412) +(with-test (:name :dead-unbound) + (assert (eq :error + (handler-case + (funcall (compile nil + '(lambda () + #:unbound + 42))) + (unbound-variable () + :error))))) + +;;; No compiler notes from compiling SUBSEQ SIMPLE-VECTOR. +(handler-bind ((sb-ext:compiler-note 'error)) + (assert + (equalp #(2 3) + (funcall (compile nil `(lambda (s p e) + (declare (optimize speed) + (simple-vector s)) + (subseq s p e))) + (vector 1 2 3 4) + 1 + 3)))) + +;;; No compiler notes from compiling COPY-SEQ SIMPLE-VECTOR. +(handler-bind ((sb-ext:compiler-note 'error)) + (assert + (equalp #(1 2 3 4) + (funcall (compile nil `(lambda (s) + (declare (optimize speed) + (simple-vector s)) + (copy-seq s))) + (vector 1 2 3 4))))) + +;;; bug in adding DATA-VECTOR-REF-WITH-OFFSET to x86-64 +(assert (not (mismatch #(1.0f0 2.0f0) (make-array 2 :element-type 'single-float :initial-contents (list 1.0f0 2.0f0))))) + +;;; bug in interval-arithmetic used by the compiler: needless attempt to coerce too +;;; large bignums to floats +(dolist (op '(* / + -)) + (let ((fun (compile + nil + `(lambda (x) + (declare (type (integer 0 #.(* 2 (truncate most-positive-double-float))) x)) + (,op 0.0d0 x))))) + (loop repeat 10 + do (let ((arg (random (truncate most-positive-double-float)))) + (assert (eql (funcall fun arg) + (funcall op 0.0d0 arg))))))) + +(with-test (:name :high-debug-known-function-inlining) + (let ((fun (compile nil + '(lambda () + (declare (optimize (debug 3)) (inline append)) + (let ((fun (lambda (body) + (append + (first body) + nil)))) + (funcall fun + '((foo (bar))))))))) + (funcall fun))) + +(with-test (:name :high-debug-known-function-transform-with-optional-arguments) + (compile nil '(lambda (x y) + (declare (optimize sb-c::preserve-single-use-debug-variables)) + (if (block nil + (some-unknown-function + (lambda () + (return (member x y)))) + t) + t + (error "~a" y)))))