X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=ff5d41b99112496e79475dabe3150532834f9599;hb=4d31006db24db375cdb83a5726d66c524b36689c;hp=b261b83af7468d377fa612aec3a0e38eb322864d;hpb=94c003b32e49fc11a182d50c405ffa18183aa005;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index b261b83..ff5d41b 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -3484,3 +3484,50 @@ (assert (not (ctu:find-named-callees fun))) (assert (= 1 (funcall fun #*000001))) (assert (= 0 (funcall fun #*000010))))) + +(with-test (:name :mult-by-one-in-float-acc-zero) + (assert (eql 1.0 (funcall (compile nil `(lambda (x) + (declare (optimize (sb-c::float-accuracy 0))) + (* x 1.0))) + 1))) + (assert (eql -1.0 (funcall (compile nil `(lambda (x) + (declare (optimize (sb-c::float-accuracy 0))) + (* x -1.0))) + 1))) + (assert (eql 1.0d0 (funcall (compile nil `(lambda (x) + (declare (optimize (sb-c::float-accuracy 0))) + (* x 1.0d0))) + 1))) + (assert (eql -1.0d0 (funcall (compile nil `(lambda (x) + (declare (optimize (sb-c::float-accuracy 0))) + (* x -1.0d0))) + 1)))) + +(with-test (:name :dotimes-non-integer-counter-value) + (assert (raises-error? (dotimes (i 8.6)) type-error))) + +(with-test (:name :bug-454681) + ;; This used to break due to reference to a dead lambda-var during + ;; inline expansion. + (assert (compile nil + `(lambda () + (multiple-value-bind (iterator+977 getter+978) + (does-not-exist-but-does-not-matter) + (flet ((iterator+976 () + (funcall iterator+977))) + (declare (inline iterator+976)) + (let ((iterator+976 #'iterator+976)) + (funcall iterator+976)))))))) + +(with-test (:name :complex-float-local-fun-args) + ;; As of 1.0.27.14, the lambda below failed to compile due to the + ;; compiler attempting to pass unboxed complex floats to Z and the + ;; MOVE-ARG method not expecting the register being used as a + ;; temporary frame pointer. Reported by sykopomp in #lispgames, + ;; reduced test case provided by _3b`. + (compile nil '(lambda (a) + (labels ((z (b c) + (declare ((complex double-float) b c)) + (* b (z b c)))) + (loop for i below 10 do + (setf a (z a a)))))))