From: Christophe Rhodes Date: Thu, 19 Sep 2002 17:19:13 +0000 (+0000) Subject: 0.7.7.31: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=93ba859423ec6e035a7b22a76a2ac70038691d65;p=sbcl.git 0.7.7.31: Fix BUG 51b (as per CSR sbcl-devel 2002-09-19) ... but with s/READER-INTERNAL-ERROR/READER-IMPOSSIBLE-NUMBER-ERROR ... and a couple more tests. Delete stale BUGS 131 and 168 --- diff --git a/BUGS b/BUGS index fb974ca..1ee8210 100644 --- a/BUGS +++ b/BUGS @@ -297,9 +297,6 @@ WORKAROUND: (DEFGENERIC FOO03 (X)) (ADD-METHOD (FUNCTION FOO03) M))) should give an error, but SBCL allows it. - b: READ should probably return READER-ERROR, not the bare - arithmetic error, when input a la "1/0" or "1e1000" causes - an arithmetic error. 52: It has been reported (e.g. by Peter Van Eynde) that there are @@ -733,65 +730,6 @@ WORKAROUND: (bar x))) shouldn't compile without error (because of the extra DEFMACRO symbol). -131: - As of sbcl-0.pre7.86.flaky7.3, the cross-compiler, and probably - the CL:COMPILE function (which is based on the same %COMPILE - mechanism) get confused by -(defun sxhash (x) - (labels ((sxhash-number (x) - (etypecase x - (fixnum (sxhash x)) ; through DEFTRANSFORM - (integer (sb!bignum:sxhash-bignum x)) - (single-float (sxhash x)) ; through DEFTRANSFORM - (double-float (sxhash x)) ; through DEFTRANSFORM - #!+long-float (long-float (error "stub: no LONG-FLOAT")) - (ratio (let ((result 127810327)) - (declare (type fixnum result)) - (mixf result (sxhash-number (numerator x))) - (mixf result (sxhash-number (denominator x))) - result)) - (complex (let ((result 535698211)) - (declare (type fixnum result)) - (mixf result (sxhash-number (realpart x))) - (mixf result (sxhash-number (imagpart x))) - result)))) - (sxhash-recurse (x &optional (depthoid +max-hash-depthoid+)) - (declare (type index depthoid)) - (typecase x - (list - (if (plusp depthoid) - (mix (sxhash-recurse (car x) (1- depthoid)) - (sxhash-recurse (cdr x) (1- depthoid))) - 261835505)) - (instance - (if (typep x 'structure-object) - (logxor 422371266 - (sxhash ; through DEFTRANSFORM - (class-name (layout-class (%instance-layout x))))) - 309518995)) - (symbol (sxhash x)) ; through DEFTRANSFORM - (number (sxhash-number x)) - (array - (typecase x - (simple-string (sxhash x)) ; through DEFTRANSFORM - (string (%sxhash-substring x)) - (bit-vector (let ((result 410823708)) - (declare (type fixnum result)) - (dotimes (i (min depthoid (length x))) - (mixf result (aref x i))) - result)) - (t (logxor 191020317 (sxhash (array-rank x)))))) - (character - (logxor 72185131 - (sxhash (char-code x)))) ; through DEFTRANSFORM - (t 42)))) - (sxhash-recurse x))) - complaining "function called with two arguments, but wants exactly - one" about SXHASH-RECURSE. (This might not be strictly a new bug, - since IIRC post-fork CMU CL has also had problems with &OPTIONAL - arguments in FLET/LABELS: it might be an old Python bug which is - only exercised by the new arrangement of the SBCL compiler.) - 135: Ideally, uninterning a symbol would allow it, and its associated FDEFINITION and PROCLAIM data, to be reclaimed by the GC. However, @@ -1022,18 +960,6 @@ WORKAROUND: macro is unhappy with the illegal syntax in the method body, and is giving an unclear error message. -168: - (reported by Dan Barlow on sbcl-devel 2002-05-10) - In sbcl-0.7.3.12, doing - (defstruct foo bar baz) - (compile nil (lambda (x) (or x (foo-baz x)))) - gives an error - debugger invoked on condition of type SB-INT:BUG: - full call to SB-KERNEL:%INSTANCE-REF - This is probably a bug in SBCL itself. [...] - Since this is a reasonable user error, it shouldn't be reported as - an SBCL bug. - 172: sbcl's treatment of at least macro lambda lists is too permissive; e.g., in sbcl-0.7.3.7: @@ -1356,13 +1282,19 @@ WORKAROUND: APD further reports that this bug is not present in CMUCL. -200: "TRANSLATE-LOGICAL-PATHNAME fails on physical pathname namestrings" - Reported by Kevin Rosenburg on #lisp IRC 2002-09-16 - (TRANSLATE-LOGICAL-PATHNAME "/") - should simply return #P"/", but signals an error in sbcl-0.7.7.28 - - Fixed in sbcl-0.7.7.29: bug temporarily left here in BUGS to avoid - its number being accidentally reallocated +201: "Incautious type inference from compound CONS types" + (reported by APD sbcl-devel 2002-09-17) + (DEFUN FOO (X) + (LET ((Y (CAR (THE (CONS INTEGER *) X)))) + (SETF (CAR X) NIL) + (FORMAT NIL "~S IS ~S, Y = ~S" + (CAR X) + (TYPECASE (CAR X) + (INTEGER 'INTEGER) + (T '(NOT INTEGER))) + Y))) + + (FOO ' (1 . 2)) => "NIL IS INTEGER, Y = 1" DEFUNCT CATEGORIES OF BUGS IR1-#: diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 9445a75..ca4183e 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1168,7 +1168,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." #+x86 "*PSEUDO-ATOMIC-ATOMIC*" #+x86 "*PSEUDO-ATOMIC-INTERRUPTED*" "PUNT-PRINT-IF-TOO-LONG" - "READER-PACKAGE-ERROR" + "READER-IMPOSSIBLE-NUMBER-ERROR" "READER-PACKAGE-ERROR" "SCALE-DOUBLE-FLOAT" "SCALE-LONG-FLOAT" "SCALE-SINGLE-FLOAT" "SEQUENCE-END" "SEQUENCE-OF-CHECKED-LENGTH-GIVEN-TYPE" diff --git a/src/code/bignum.lisp b/src/code/bignum.lisp index 9fd5085..cf70586 100644 --- a/src/code/bignum.lisp +++ b/src/code/bignum.lisp @@ -980,8 +980,16 @@ (declare (type bignum-index len)) (let ((exp (+ exp bias))) (when (> exp max) - (error "Too large to be represented as a ~S:~% ~S" - format x)) + ;; Why a SIMPLE-TYPE-ERROR? Well, this is mainly + ;; called by COERCE, which requires an error of + ;; TYPE-ERROR if the conversion can't happen + ;; (except in certain circumstances when we are + ;; coercing to a FUNCTION) -- CSR, 2002-09-18 + (error 'simple-type-error + :format-control "Too large to be represented as a ~S:~% ~S" + :format-arguments (list format x) + :expected-type format + :datum x)) exp))) (cond diff --git a/src/code/condition.lisp b/src/code/condition.lisp index 9a3ae5e..1e5c7c7 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -735,6 +735,17 @@ "unexpected end of file on ~S ~A" (stream-error-stream condition) (reader-eof-error-context condition))))) + +(define-condition reader-impossible-number-error (reader-error) + ((error :reader reader-impossible-number-error-error :initarg :error)) + (:report + (lambda (condition stream) + (let ((error-stream (stream-error-stream condition))) + (format stream "READER-ERROR ~@[at ~W ~]on ~S:~%~?~%Original error: ~A" + (file-position error-stream) error-stream + (reader-error-format-control condition) + (reader-error-format-arguments condition) + (reader-impossible-number-error-error condition)))))) ;;;; special SBCL extension conditions diff --git a/src/code/reader.lisp b/src/code/reader.lisp index d85f441..2372ef8 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -800,13 +800,13 @@ RIGHTDIGIT ; saw "[sign] {digit}* dot {digit}+" (ouch-read-buffer char) (setq char (read-char stream nil nil)) - (unless char (return (make-float))) + (unless char (return (make-float stream))) (case (char-class char attribute-table) (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-expt+ (go EXPONENT)) (#.+char-attr-delimiter+ (unread-char char stream) - (return (make-float))) + (return (make-float stream))) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) @@ -859,12 +859,12 @@ EXPTDIGIT ; got to EXPONENT, saw "[sign] {digit}+" (ouch-read-buffer char) (setq char (read-char stream nil nil)) - (unless char (return (make-float))) + (unless char (return (make-float stream))) (case (char-class char attribute-table) (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) - (return (make-float))) + (return (make-float stream))) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) @@ -883,12 +883,12 @@ RATIODIGIT ; saw "[sign] {digit}+ slash {digit}+" (ouch-read-buffer char) (setq char (read-char stream nil nil)) - (unless char (return (make-ratio))) + (unless char (return (make-ratio stream))) (case (char-class2 char attribute-table) (#.+char-attr-constituent-digit+ (go RATIODIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) - (return (make-ratio))) + (return (make-ratio stream))) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) @@ -1147,7 +1147,7 @@ (the index (* num base)))))))) (setq number (+ num (* number base-power))))))) -(defun make-float () +(defun make-float (stream) ;; Assume that the contents of *read-buffer* are a legal float, with nothing ;; else after it. (read-unwind-read-buffer) @@ -1181,7 +1181,8 @@ (cond ((eofp char) ;; If not, we've read the whole number. (let ((num (make-float-aux number divisor - *read-default-float-format*))) + *read-default-float-format* + stream))) (return-from make-float (if negative-fraction (- num) num)))) ((exponent-letterp char) (setq float-char char) @@ -1243,7 +1244,7 @@ 0)))) (incf exponent correction) (setf number (/ number (expt 10 correction))) - (setq num (make-float-aux number divisor float-format)) + (setq num (make-float-aux number divisor float-format stream)) (setq num (* num (expt 10 exponent))) (return-from make-float (if negative-fraction (- num) @@ -1251,10 +1252,15 @@ ;; should never happen (t (bug "bad fallthrough in floating point reader"))))) -(defun make-float-aux (number divisor float-format) - (coerce (/ number divisor) float-format)) +(defun make-float-aux (number divisor float-format stream) + (handler-case + (coerce (/ number divisor) float-format) + (type-error (c) + (error 'reader-impossible-number-error + :error c :stream stream + :format-control "failed to build float")))) -(defun make-ratio () +(defun make-ratio (stream) ;; Assume *READ-BUFFER* contains a legal ratio. Build the number from ;; the string. ;; @@ -1278,7 +1284,12 @@ (dig ())) ((or (eofp ch) (not (setq dig (digit-char-p ch *read-base*))))) (setq denominator (+ (* denominator *read-base*) dig))) - (let ((num (/ numerator denominator))) + (let ((num (handler-case + (/ numerator denominator) + (arithmetic-error (c) + (error 'reader-impossible-number-error + :error c :stream stream + :format-control "failed to build ratio"))))) (if negative-number (- num) num)))) ;;;; cruft for dispatch macros diff --git a/tests/arith.impure.lisp b/tests/arith.impure.lisp index 6604a9f..668ba38 100644 --- a/tests/arith.impure.lisp +++ b/tests/arith.impure.lisp @@ -65,4 +65,6 @@ (assert (null (ignore-errors (compiled-logxor #c(2 3))))) (assert (= (compiled-logxor -6) -6)) +(assert (raises-error? (coerce (expt 10 1000) 'single-float) type-error)) + (sb-ext:quit :unix-status 104) \ No newline at end of file diff --git a/tests/reader.impure.lisp b/tests/reader.impure.lisp index a518f25..560ea98 100644 --- a/tests/reader.impure.lisp +++ b/tests/reader.impure.lisp @@ -15,6 +15,8 @@ (in-package :cl-user) +(load "assertoid.lisp") + ;;; Bug 30, involving mistakes in binding the read table, made this ;;; code fail. (defun read-vector (stream char) @@ -35,5 +37,10 @@ (assert (equalp res #(#\x))) (assert (= pos 5))) +;;; Bug 51b. (try to throw READER-ERRORs when the reader encounters +;;; dubious input) +(assert (raises-error? (read-from-string "1e1000") reader-error)) +(assert (raises-error? (read-from-string "1/0") reader-error)) + ;;; success (quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 1ca0368..f923a5f 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -18,4 +18,4 @@ ;;; internal versions off the main CVS branch, it gets hairier, e.g. ;;; "0.pre7.14.flaky4.13".) -"0.7.7.30" +"0.7.7.31"