Fix a bug introduced in 0.9.3.44 (reported by James Y Knight
sbcl-devel 2005-08-19)
... when a bound is more extreme than
most-frobtive-fooble-float, make an open bound;
... when both thingies are of the same type of float,
safely-binop can proceed regardless (as float-traps
are masked).
... James Y Knight's test case.
((and format (subtypep format 'double-float))
(if (<= most-negative-double-float cx most-positive-double-float)
(coerce cx format)
((and format (subtypep format 'double-float))
(if (<= most-negative-double-float cx most-positive-double-float)
(coerce cx format)
- (if (< x most-negative-double-float)
- most-negative-double-float most-positive-double-float)))
(t
(if (<= most-negative-single-float cx most-positive-single-float)
(coerce cx format)
(t
(if (<= most-negative-single-float cx most-positive-single-float)
(coerce cx format)
- (if (< x most-negative-single-float)
- most-negative-single-float most-positive-single-float))))))
(if (consp x) (list res) res)))))
nil))
(if (consp x) (list res) res)))))
nil))
(defmacro safely-binop (op x y)
`(cond
((typep ,x 'single-float)
(defmacro safely-binop (op x y)
`(cond
((typep ,x 'single-float)
- (if (<= most-negative-single-float ,y most-positive-single-float)
+ (if (or (typep ,y 'single-float)
+ (<= most-negative-single-float ,y most-positive-single-float))
(,op ,x ,y)))
((typep ,x 'double-float)
(,op ,x ,y)))
((typep ,x 'double-float)
- (if (<= most-negative-double-float ,y most-positive-double-float)
+ (if (or (typep ,y 'double-float)
+ (<= most-negative-double-float ,y most-positive-double-float))
(,op ,x ,y)))
((typep ,y 'single-float)
(if (<= most-negative-single-float ,x most-positive-single-float)
(,op ,x ,y)))
((typep ,y 'single-float)
(if (<= most-negative-single-float ,x most-positive-single-float)
(assert (= (test 1.0d0) 2.0d0))
(assert (= (test 1.0d0) 2.0d0))
+(deftype myarraytype (&optional (length '*))
+ `(simple-array double-float (,length)))
+(defun new-pu-label-from-pu-labels (array)
+ (setf (aref (the myarraytype array) 0)
+ sb-ext:double-float-positive-infinity))
+
;;; success
(quit :unix-status 104)
;;; success
(quit :unix-status 104)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)