From 72826ded21763d6885dd8a34552cb57edfb1cf26 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Tue, 9 Sep 2003 07:09:48 +0000 Subject: [PATCH] 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. --- BUGS | 12 +----------- NEWS | 6 ++++++ src/code/reader.lisp | 12 ++++++------ src/compiler/generic/vm-tran.lisp | 2 +- src/compiler/srctran.lisp | 11 +++++++---- tests/compiler.impure-cload.lisp | 5 +++++ tests/reader.pure.lisp | 18 +++++++++++++++++- version.lisp-expr | 2 +- 8 files changed, 44 insertions(+), 24 deletions(-) diff --git a/BUGS b/BUGS index 29b0af6..7a11471 100644 --- 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 --- 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 ) returned . ** 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 --- 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)))))) ;;;; reader initialization code diff --git a/src/compiler/generic/vm-tran.lisp b/src/compiler/generic/vm-tran.lisp index 4bb3a9f..e5073ff 100644 --- 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 --- 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 --- 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))))) (sb-ext:quit :unix-status 104) diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index f064457..33af266 100644 --- 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 --- 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" -- 1.7.10.4