(logand most-positive-fixnum (* x most-positive-fixnum))))
;;; bug 256.b
-(assert (let (warned-p)
+(with-test (:name :propagate-type-through-error-and-binding)
+ (assert (let (warned-p)
(handler-bind ((warning (lambda (w) (setf warned-p t))))
(compile nil
- '(lambda (x)
- (list (let ((y (the real x)))
- (unless (floatp y) (error ""))
- y)
- (integer-length x)))))
- warned-p))
+ '(lambda (x)
+ (list (let ((y (the real x)))
+ (unless (floatp y) (error ""))
+ y)
+ (integer-length x)))))
+ warned-p)))
;; Dead / in safe code
(with-test (:name :safe-dead-/)
(assert (eql x (funcall fun i)))
(assert (eql (- x) (funcall fun i))))))))
-(with-test (:name (load-time-value :type-derivation))
- (flet ((test (type form value-cell-p)
- (let ((derived (funcall (compile
- nil
- `(lambda ()
- (ctu:compiler-derived-type
- (load-time-value ,form)))))))
- (unless (equal type derived)
- (error "wanted ~S, got ~S" type derived)))))
- (let ((* 10))
- (test '(integer 11 11) '(+ * 1) nil))
- (let ((* "fooo"))
- (test '(integer 4 4) '(length *) t))))
-
(with-test (:name :float-division-using-exact-reciprocal)
(flet ((test (lambda-form arg res &key (check-insts t))
(let* ((fun (compile nil lambda-form))
(assert (equal `(function ((single-float (0.0)))
(values (or (member 0.0) (single-float (0.0))) &optional))
(sb-kernel:%simple-fun-type f)))))
+
+(with-test (:name (:bug-486812 single-float))
+ (compile nil `(lambda ()
+ (sb-kernel:make-single-float -1))))
+
+(with-test (:name (:bug-486812 double-float))
+ (compile nil `(lambda ()
+ (sb-kernel:make-double-float -1 0))))
+
+(with-test (:name :bug-729765)
+ (compile nil `(lambda (a b)
+ (declare ((integer 1 1) a)
+ ((integer 0 1) b)
+ (optimize debug))
+ (lambda () (< b a)))))
+
+;; Actually tests the assembly of RIP-relative operands to comparison
+;; functions (one of the few x86 instructions that have extra bytes
+;; *after* the mem operand's effective address, resulting in a wrong
+;; offset).
+(with-test (:name :cmpps)
+ (let ((foo (compile nil `(lambda (x)
+ (= #C(2.0 3.0) (the (complex single-float) x))))))
+ (assert (funcall foo #C(2.0 3.0)))
+ (assert (not (funcall foo #C(1.0 2.0))))))
+
+(with-test (:name :cmppd)
+ (let ((foo (compile nil `(lambda (x)
+ (= #C(2d0 3d0) (the (complex double-float) x))))))
+ (assert (funcall foo #C(2d0 3d0)))
+ (assert (not (funcall foo #C(1d0 2d0))))))
+
+(with-test (:name :lvar-externally-checkable-type-nil)
+ ;; Used to signal a BUG during compilation.
+ (let ((fun (compile nil `(lambda (a) (parse-integer "12321321" (the (member :start) a) 1)))))
+ (multiple-value-bind (i p) (funcall fun :start)
+ (assert (= 2321321 i))
+ (assert (= 8 p)))
+ (multiple-value-bind (i e) (ignore-errors (funcall fun :end))
+ (assert (not i))
+ (assert (typep e 'type-error)))))