0.8.3.47:

        * Fix bugs in PARSE-INTEGER related to the index in
          :JUNK-ALLOWED NIL case and to displaced string processing
          reported by Paul Dietz;
        * fix bug 145b: in CONVERT-MEMBER-TYPE bail out to (TYPE-OF
          MEMBER) in difficult cases.

diff --git a/BUGS b/BUGS
index 29b0af6..7a11471 100644 (file)
--- a/BUGS
+++ b/BUGS
@@ -501,17 +501,7 @@ WORKAROUND:
   conformance problem, since seems hard to construct useful code
   where it matters.)
 
-  b.
-  * (defun foo (x)
-      (declare (type (double-float -0d0) x))
-      (declare (optimize speed))
-      (+ x (sqrt (log (random 1d0)))))
-  debugger invoked on condition of type SIMPLE-ERROR:
-    bad thing to be a type specifier: ((COMPLEX
-                                        (DOUBLE-FLOAT 0.0d0
-                                                      #.SB-EXT:DOUBLE-FLOAT-POSITIVE-INFINITY))
-                                       #C(0.0d0 #.SB-EXT:DOUBLE-FLOAT-POSITIVE-INFINITY)
-                                       #C(0.0d0 #.SB-EXT:DOUBLE-FLOAT-POSITIVE-INFINITY))
+  b. (fixed in 0.8.3.43)
 
 146:
   Floating point errors are reported poorly. E.g. on x86 OpenBSD

diff --git a/NEWS b/NEWS
index fbbdb39..a6c9ad7 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2033,6 +2033,8 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
     x86 LEA instruction for multiplication by constants.
   * bug fix: in some situations compiler did not report usage of
     generic arithmetic in (SPEED 3) policy.
+  * bug 145b fix: compiler used wrong type specifier while converting
+    MEMBER-types to numeric.
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** the RETURN clause in LOOP is now equivalent to DO (RETURN ...).
     ** ROUND and FROUND now give the right answer when given very
@@ -2042,6 +2044,10 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
     ** optimizer for (EXPT X 0) did not work for X not of type FLOAT.
     ** (GCD 0 <negative-integer>) returned <negative-integer>.
     ** LCM should return a non-negative integer.
+    ** PARSE-INTEGER returned the index of a terminator instead of the
+       upper bounding index of a substring in case :JUNK-ALLOWED NIL.
+    ** PARSE-INTEGER returned an incorrect index being applied to a
+       displaced string.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles

diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index afb6909..3ec1059 100644 (file)
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -1431,7 +1431,7 @@
               `(error 'simple-parse-error
                       :format-control ,format-control
                       :format-arguments (list string))))
-    (with-array-data ((string string)
+    (with-array-data ((string string :offset-var offset)
                      (start start)
                      (end (%check-vector-sequence-bounds string start end)))
       (let ((index (do ((i start (1+ i)))
@@ -1460,10 +1460,10 @@
                        found-digit t))
                 (junk-allowed (return nil))
                 ((whitespacep char)
-                 (do ((jndex (1+ index) (1+ jndex)))
-                     ((= jndex end))
-                   (declare (fixnum jndex))
-                   (unless (whitespacep (char string jndex))
+                  (loop
+                   (incf index)
+                   (when (= index end) (return))
+                   (unless (whitespacep (char string index))
                      (parse-error "junk in string ~S")))
                  (return nil))
                 (t
@@ -1475,7 +1475,7 @@
             (if junk-allowed
                 nil
                 (parse-error "no digits in string ~S")))
-        index)))))
+        (- index offset))))))
 \f
 ;;;; reader initialization code
 

diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp
index 4bb3a9f..e5073ff 100644 (file)
--- a/src/compiler/generic/vm-tran.lisp
+++ b/src/compiler/generic/vm-tran.lisp
@@ -471,7 +471,7 @@
 ;;; the high order bit is bit 31 because shifting by 32 doesn't work
 ;;; too well.
 (defun ub32-strength-reduce-constant-multiply (arg num)
-  (declare (type (unsigned-byte 32) numb))
+  (declare (type (unsigned-byte 32) num))
   (let ((adds 0) (shifts 0)
        (result nil) first-one)
     (labels ((tub32 (x) `(truly-the (unsigned-byte 32) ,x))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index adb1dc2..9fa22a2 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -992,10 +992,13 @@
         (member (first members))
         (member-type (type-of member)))
     (aver (not (rest members)))
-    (specifier-type `(,(if (subtypep member-type 'integer)
-                          'integer
-                          member-type)
-                     ,member ,member))))
+    (specifier-type (cond ((typep member 'integer)
+                           `(integer ,member ,member))
+                          ((memq member-type '(short-float single-float
+                                               double-float long-float))
+                           `(,member-type ,member ,member))
+                          (t
+                           member-type)))))
 
 ;;; This is used in defoptimizers for computing the resulting type of
 ;;; a function.

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 05a1145..b012b17 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -156,5 +156,10 @@
      (funcall (eval ''list) y (+ y 2d0) (* y 3d0)))))
 (assert (raises-error? (bug233a 4) type-error))
 
+;;; compiler failure
+(defun bug145b (x)
+  (declare (type (double-float -0d0) x))
+  (declare (optimize speed))
+  (+ x (sqrt (log (random 1d0)))))
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index f064457..33af266 100644 (file)
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -90,4 +90,20 @@
          (handler-case (with-input-from-string (s "cl:") (read s))
            (end-of-file (c)
              'good))
-         'good))
\ No newline at end of file
+         'good))
+
+;;; Bugs found by Paul Dietz
+(assert (equal (multiple-value-list
+                (parse-integer "   123      "))
+               '(123 12)))
+
+(let* ((base "xxx 123  yyy")
+       (intermediate (make-array 8 :element-type (array-element-type base)
+                                 :displaced-to base
+                                 :displaced-index-offset 2))
+       (string (make-array 6 :element-type (array-element-type base)
+                           :displaced-to intermediate
+                           :displaced-index-offset 1)))
+  (assert (equal (multiple-value-list
+                  (parse-integer string))
+                 '(123 6))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 0433317..14d6bf7 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.8.3.46"
+"0.8.3.47"