From: Christophe R. <cr...@us...> - 2002-09-19 17:19:19
|
Update of /cvsroot/sbcl/sbcl/src/code In directory usw-pr-cvs1:/tmp/cvs-serv14113/src/code Modified Files: bignum.lisp condition.lisp reader.lisp Log Message: 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 Index: bignum.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/bignum.lisp,v retrieving revision 1.6 retrieving revision 1.7 diff -u -d -r1.6 -r1.7 --- bignum.lisp 15 Jan 2002 23:53:51 -0000 1.6 +++ bignum.lisp 19 Sep 2002 17:19:16 -0000 1.7 @@ -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 Index: condition.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/condition.lisp,v retrieving revision 1.16 retrieving revision 1.17 diff -u -d -r1.16 -r1.17 --- condition.lisp 10 Sep 2002 18:53:41 -0000 1.16 +++ condition.lisp 19 Sep 2002 17:19:16 -0000 1.17 @@ -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 Index: reader.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v retrieving revision 1.22 retrieving revision 1.23 diff -u -d -r1.22 -r1.23 --- reader.lisp 7 Aug 2002 12:27:51 -0000 1.22 +++ reader.lisp 19 Sep 2002 17:19:16 -0000 1.23 @@ -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 |