(error "bad RANDOM event"))))
;;; 0.8.17.28-sma.1 lost derived type information.
-(handler-bind ((sb-ext:compiler-note #'error))
- (compile nil
- '(lambda (x y v)
- (declare (optimize (speed 3) (safety 0)))
- (declare (type (integer 0 80) x)
- (type (integer 0 11) y)
- (type (simple-array (unsigned-byte 32) (*)) v))
- (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
- nil)))
+(with-test (:name "0.8.17.28-sma.1" :fails-on :sparc)
+ (handler-bind ((sb-ext:compiler-note (lambda (c) (error "~A" c))))
+ (compile nil
+ '(lambda (x y v)
+ (declare (optimize (speed 3) (safety 0)))
+ (declare (type (integer 0 80) x)
+ (type (integer 0 11) y)
+ (type (simple-array (unsigned-byte 32) (*)) v))
+ (setf (aref v 0) (* (* x #.(floor (ash 1 32) (* 11 80))) y))
+ nil))))
;;; Bug reported by Robert J. Macomber: instrumenting of more-entry
;;; prevented open coding of %LISTIFY-REST-ARGS.
new)))
(declare (ignore fun warnings failure))
(assert (not failure)))
+
+;;; bug #389: "0.0 can't be converted to type NIL." (Brian Rowe
+;;; sbcl-devel)
+(compile nil '(lambda (x y a b c)
+ (- y (* (signum x) (sqrt (abs (- (* b x) c)))))))
+
+;;; Type inference from CHECK-TYPE
+(let ((count0 0) (count1 0))
+ (handler-bind ((sb-ext:compiler-note (lambda (c) (incf count0))))
+ (compile nil '(lambda (x)
+ (declare (optimize (speed 3)))
+ (1+ x))))
+ ;; forced-to-do GENERIC-+, etc
+ (assert (> count0 0))
+ (handler-bind ((sb-ext:compiler-note (lambda (c) (incf count1))))
+ (compile nil '(lambda (x)
+ (declare (optimize (speed 3)))
+ (check-type x fixnum)
+ (1+ x))))
+ (assert (= count1 0)))
+
+;;; Up to 0.9.8.22 x86-64 had broken return value handling in the
+;;; %SET-SAP-REF-DOUBLE/SINGLE VOPs.
+(with-test (:name :sap-ref-float)
+ (compile nil '(lambda (sap)
+ (let ((x (setf (sb-vm::sap-ref-double sap 0) 1d0)))
+ (1+ x))))
+ (compile nil '(lambda (sap)
+ (let ((x (setf (sb-vm::sap-ref-single sap 0) 1d0)))
+ (1+ x)))))
+
+;;; bug #399
+(with-test (:name :string-union-types)
+ (compile nil '(lambda (x)
+ (declare (type (or (simple-array character (6))
+ (simple-array character (5))) x))
+ (aref x 0))))
+
+;;; MISC.623: missing functions for constant-folding
+(assert (eql 0
+ (funcall
+ (compile
+ nil
+ '(lambda ()
+ (declare (optimize (space 2) (speed 0) (debug 2)
+ (compilation-speed 3) (safety 0)))
+ (loop for lv3 below 1
+ count (minusp
+ (loop for lv2 below 2
+ count (logbitp 0
+ (bit #*1001101001001
+ (min 12 (max 0 lv3))))))))))))
+
+;;; MISC.624: erronous AVER in x86's %LOGBITP VOPs
+(assert (eql 0
+ (funcall
+ (compile
+ nil
+ '(lambda (a)
+ (declare (type (integer 21 28) a))
+ (declare (optimize (compilation-speed 1) (safety 2)
+ (speed 0) (debug 0) (space 1)))
+ (let* ((v7 (flet ((%f3 (f3-1 f3-2)
+ (loop for lv2 below 1
+ count
+ (logbitp 29
+ (sbit #*10101111
+ (min 7 (max 0 (eval '0))))))))
+ (%f3 0 a))))
+ 0)))
+ 22)))
+
+;;; MISC.626: bandaged AVER was still wrong
+(assert (eql -829253
+ (funcall
+ (compile
+ nil
+ '(lambda (a)
+ (declare (type (integer -902970 2) a))
+ (declare (optimize (space 2) (debug 0) (compilation-speed 1)
+ (speed 0) (safety 3)))
+ (prog2 (if (logbitp 30 a) 0 (block b3 0)) a)))
+ -829253)))
+
+;; MISC.628: constant-folding %LOGBITP was buggy
+(assert (eql t
+ (funcall
+ (compile
+ nil
+ '(lambda ()
+ (declare (optimize (safety 3) (space 3) (compilation-speed 3)
+ (speed 0) (debug 1)))
+ (not (not (logbitp 0 (floor 2147483651 (min -23 0))))))))))