X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fcompiler.pure.lisp;h=1305c5c323d54355e6b0bbd44d98e8e86f91dc7a;hb=4ed3f0d08c3a57a6762018d9622f253ab9d0f2b6;hp=f1431f1d71bd148bb99e8c0428ac99279d7d0cf0;hpb=8f4ef01b8c9930d7dd0a56a96845a6d84ca5774d;p=sbcl.git diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index f1431f1..1305c5c 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -606,6 +606,35 @@ (+ 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 @@ -614,3 +643,150 @@ (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)) + +;;; bug in modular arithmetic and type specifiers +(assert (= (funcall (compile nil (lambda (x) (logand x x 0))) + -1) + 0)) + +;;; MISC.99 from Paul Dietz' random tester: FAST-ASH-MOD32-C VOP +;;; produced wrong result for shift >=32 on X86 +(assert (= 0 (funcall + (compile nil + '(lambda (a) + (declare (type (integer 4303063 101130078) a)) + (mask-field (byte 18 2) (ash a 77)))) + 57132532))) + +;;; MISC.101 and MISC.103: FLUSH-DEST did not mark the USE's block for +;;; type check regeneration +(assert (eql (funcall + (compile nil '(lambda (a c) + (declare (type (integer 185501219873 303014665162) a)) + (declare (type (integer -160758 255724) c)) + (declare (optimize (speed 3))) + (let ((v8 + (- -554046873252388011622614991634432 + (ignore-errors c) + (unwind-protect 2791485)))) + (max (ignore-errors a) + (let ((v6 (- v8 (restart-case 980)))) + (min v8 v6)))))) + 259448422916 173715) + 259448422916)) +(assert (eql (funcall + (compile nil '(lambda (a b) + (min -80 + (abs + (ignore-errors + (+ + (logeqv b + (block b6 + (return-from b6 + (load-time-value -6876935)))) + (if (logbitp 1 a) b (setq a -1522022182249)))))))) + -1802767029877 -12374959963) + -80)) + +;;; various MISC.*, related to NODEs/LVARs with derived type NIL +(assert (eql (funcall (compile nil '(lambda (c) + (declare (type (integer -3924 1001809828) c)) + (declare (optimize (speed 3))) + (min 47 (if (ldb-test (byte 2 14) c) + -570344431 + (ignore-errors -732893970))))) + 705347625) + -570344431)) +(assert (eql (funcall + (compile nil '(lambda (b) + (declare (type (integer -1598566306 2941) b)) + (declare (optimize (speed 3))) + (max -148949 (ignore-errors b)))) + 0) + 0)) +(assert (eql (funcall + (compile nil '(lambda (b c) + (declare (type (integer -4 -3) c)) + (block b7 + (flet ((%f1 (f1-1 f1-2 f1-3) + (if (logbitp 0 (return-from b7 + (- -815145138 f1-2))) + (return-from b7 -2611670) + 99345))) + (let ((v2 (%f1 -2464 (%f1 -1146 c c) -2))) + b))))) + 2950453607 -4) + -815145134)) +(assert (eql (funcall + (compile nil + '(lambda (b c) + (declare (type (integer -29742055786 23602182204) b)) + (declare (type (integer -7409 -2075) c)) + (declare (optimize (speed 3))) + (floor + (labels ((%f2 () + (block b6 + (ignore-errors (return-from b6 + (if (= c 8) b 82674)))))) + (%f2))))) + 22992834060 -5833) + 82674)) +(assert (equal (multiple-value-list + (funcall + (compile nil '(lambda (a) + (declare (type (integer -944 -472) a)) + (declare (optimize (speed 3))) + (round + (block b3 + (return-from b3 + (if (= 55957 a) -117 (ignore-errors + (return-from b3 a)))))))) + -589)) + '(-589 0)))