0.9.5.82:

	Commit band-aid fix for compiler float / ROUND-NUMERIC-BOUND
	problem, and document the real problem

diff --git a/BUGS b/BUGS
index 1c750b4..87c19e6 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -2122,3 +2122,15 @@ WORKAROUND:
 
     SB-PCL::SPECIALIZER-APPLICABLE-USING-TYPE-P cannot handle the second argument
     (UNSIGNED-BYTE 8).
+
+389:
+  (reported several times on sbcl-devel, by Rick Taube, Brian Rowe and
+  others)
+
+  ROUND-NUMERIC-BOUND assumes that float types always have a FORMAT
+  specifying whether they're SINGLE or DOUBLE.  This is true for types
+  computed by the type system itself, but the compiler type derivation
+  short-circuits this and constructs non-canonical types.  A temporary
+  fix was made to ROUND-NUMERIC-BOUND for the sbcl-0.9.6 release, but
+  the right fix is to remove the abstraction violation in the
+  compiler's type deriver.

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index 08adf4d..abe32f2 100644 (file)
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -2118,7 +2118,8 @@ used for a COMPLEX component.~:@>"
                          nil))
                     (t
                      (if (<= most-negative-single-float cx most-positive-single-float)
-                         (coerce cx format)
+                         ;; FIXME: bug #389
+                         (coerce cx (or format 'single-float))
                          nil)))))
              (if (consp x) (list res) res)))))
       nil))

diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index dd6a23b..45d030b 100644 (file)
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -1067,4 +1067,60 @@
           (test f2 42 (1+ most-positive-fixnum))))
       (assert (= e-count 4)))))
 
+;;; bug #389 (Rick Taube sbcl-devel)
+(defun bes-jn (unn ux)
+   (let ((nn unn) (x ux))
+     (let* ((n (floor (abs nn)))
+            (besn
+             (if (= n 0)
+                 (bes-j0 x)
+                 (if (= n 1)
+                     (bes-j1 x)
+                     (if (zerop x)
+                         0.0
+                         (let ((iacc 40)
+                               (ans 0.0)
+                               (bigno 1.0e+10)
+                               (bigni 1.0e-10))
+                           (if (> (abs x) n)
+                               (do ((tox (/ 2.0 (abs x)))
+                                    (bjm (bes-j0 (abs x)))
+                                    (bj (bes-j1 (abs x)))
+                                    (j 1 (+ j 1))
+                                    (bjp 0.0))
+                                   ((= j n) (setf ans bj))
+                                 (setf bjp (- (* j tox bj) bjm))
+                                 (setf bjm bj)
+                                 (setf bj bjp))
+                               (let ((tox (/ 2.0 (abs x)))
+                                     (m
+                                      (* 2
+                                         (floor
+                                          (/ (+ n (sqrt (* iacc n)))
+                                             2))))
+                                     (jsum 0.0)
+                                     (bjm 0.0)
+                                     (sum 0.0)
+                                     (bjp 0.0)
+                                     (bj 1.0))
+                                 (do ((j m (- j 1)))
+                                     ((= j 0))
+                                   (setf bjm (- (* j tox bj) bjp))
+                                   (setf bjp bj)
+                                   (setf bj bjm)
+                                   (when (> (abs bj) bigno)
+                                     (setf bj (* bj bigni))
+                                     (setf bjp (* bjp bigni))
+                                     (setf ans (* ans bigni))
+                                     (setf sum (* sum bigni)))
+                                   (if (not (= 0 jsum)) (incf sum bj))
+                                   (setf jsum (- 1 jsum))
+                                   (if (= j n) (setf ans bjp)))
+                                 (setf sum (- (* 2.0 sum) bj))
+                                 (setf ans (/ ans sum))))
+                           (if (and (minusp x) (oddp n))
+                               (- ans)
+                               ans)))))))
+       (if (and (minusp nn) (oddp nn)) (- besn) besn))))
+
 ;;; success

diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 38de3f6..c58eb9e 100644 (file)
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -1883,3 +1883,8 @@
                      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)))))))

diff --git a/version.lisp-expr b/version.lisp-expr
index bd59d21..302dda0 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; 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".)
-"0.9.5.81"
+"0.9.5.82"