(handler-case (compile nil '(lambda (x)
(declare (optimize (speed 3) (safety 0)))
(the double-float (sqrt (the double-float x)))))
- (sb-ext:compiler-note ()
- (error "Compiler does not trust result type assertion.")))
+ (sb-ext:compiler-note (c)
+ ;; Ignore the note for the float -> pointer conversion of the
+ ;; return value.
+ (unless (string= (car (last (sb-c::simple-condition-format-arguments c)))
+ "<return value>")
+ (error "Compiler does not trust result type assertion."))))
(let ((f (compile nil '(lambda (x)
(declare (optimize speed (safety 0)))
(compile nil '(lambda (x)
(declare (optimize (speed 3)))
(1+ x))))
- ;; forced-to-do GENERIC-+, etc
- (assert (> count0 0))
+ ;; forced-to-do GENERIC-+, etc, possible word -> bignum conversion note
+ (assert (> count0 1))
(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)))
+ ;; Only the posssible word -> bignum conversion note
+ (assert (= count1 1)))
;;; Up to 0.9.8.22 x86-64 had broken return value handling in the
;;; %SET-SAP-REF-DOUBLE/SINGLE VOPs.
(compiler-note () (throw :note nil)))
(error "Unreachable code undetected.")))
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-var-1))
+ (catch :note
+ (handler-case
+ (compile nil '(lambda (x y)
+ (when (typep y 'fixnum)
+ (when (eql x y)
+ (unless (typep x 'fixnum)
+ (error "This is unreachable"))
+ (setq y nil)))))
+ (compiler-note () (throw :note nil)))
+ (error "Unreachable code undetected.")))
+
+(with-test (:name (:compiler :constraint-propagation :var-eql-to-var-2))
+ (catch :note
+ (handler-case
+ (compile nil '(lambda (x y)
+ (when (typep y 'fixnum)
+ (when (eql y x)
+ (unless (typep x 'fixnum)
+ (error "This is unreachable"))
+ (setq y nil)))))
+ (compiler-note () (throw :note nil)))
+ (error "Unreachable code undetected.")))
+
;; Reported by John Wiseman, sbcl-devel
;; Subject: [Sbcl-devel] float type derivation bug?
;; Date: Tue, 4 Apr 2006 15:28:15 -0700
;;; overconfident primitive type computation leading to bogus type
;;; checking.
-(let* ((form1 '(lambda (x)
- (declare (type (and condition function) x))
+(let* ((form1 '(lambda (x)
+ (declare (type (and condition function) x))
x))
(fun1 (compile nil form1))
- (form2 '(lambda (x)
- (declare (type (and standard-object function) x))
+ (form2 '(lambda (x)
+ (declare (type (and standard-object function) x))
x))
(fun2 (compile nil form2)))
(assert (raises-error? (funcall fun1 (make-condition 'error))))
(assert (raises-error? (funcall fun1 fun1)))
(assert (raises-error? (funcall fun2 fun2)))
(assert (eq (funcall fun2 #'print-object) #'print-object)))
+
+;;; LET* + VALUES declaration: while the declaration is a non-standard
+;;; and possibly a non-conforming extension, as long as we do support
+;;; it, we might as well get it right.
+;;;
+;;; Bug reported by Kaersten Poeck on sbcl-devel 20061023.
+(compile nil '(lambda () (let* () (declare (values list)))))