From: Christophe Rhodes Date: Tue, 16 Mar 2004 12:19:04 +0000 (+0000) Subject: 0.8.8.27: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=56a972e201d117a8d5d769527f2bafd23cba7de9;p=sbcl.git 0.8.8.27: Fix for float reading with *READ-BASE* < 10 (part of the failures in PRINT.SINGLE-FLOAT.RANDOM et al. from PFD) ... appropriate mysteriously-missing 9 entry for DECIMAL-DIGIT ... some extra states in the tokenizer FSM ... tests! --- diff --git a/NEWS b/NEWS index 0b1ee32..95c3d37 100644 --- a/NEWS +++ b/NEWS @@ -2354,6 +2354,8 @@ changes in sbcl-0.8.9 relative to sbcl-0.8.8: constitute a word. ** Printing the "Space" character with escaping on now yields "#\\ ", rather than "#\\Space", as mandated by ANSI 22.1.3.2. + ** Reading floating-point numbers with *READ-BASE* set to a number + less than 10 works correctly. 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 92d8ee4..4980544 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -659,7 +659,7 @@ (if (digit-char-p ,char (max *read-base* 10)) (if (digit-char-p ,char *read-base*) +char-attr-constituent-digit+ - +char-attr-constituent+) + +char-attr-constituent-decimal-digit+) att)))) ;;;; token fetching @@ -743,6 +743,7 @@ (case (char-class3 char attribute-table) (#.+char-attr-constituent-sign+ (go SIGN)) (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT)) (#.+char-attr-constituent-dot+ (go FRONTDOT)) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) @@ -757,6 +758,7 @@ possibly-float t) (case (char-class3 char attribute-table) (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT)) (#.+char-attr-constituent-dot+ (go SIGNDOT)) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) @@ -769,6 +771,9 @@ (unless char (return (make-integer))) (case (char-class3 char attribute-table) (#.+char-attr-constituent-digit+ (go LEFTDIGIT)) + (#.+char-attr-constituent-decimal-digit+ (if possibly-float + (go LEFTDECIMALDIGIT) + (go SYMBOL))) (#.+char-attr-constituent-dot+ (if possibly-float (go MIDDLEDOT) (go SYMBOL))) @@ -782,13 +787,36 @@ (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) + LEFTDECIMALDIGIT ; saw "[sign] {decimal-digit}+" + (aver possibly-float) + (ouch-read-buffer char) + (setq char (read-char stream nil nil)) + (unless char (go RETURN-SYMBOL)) + (case (char-class3 char attribute-table) + (#.+char-attr-constituent-digit+ (if possibly-float + (go LEFTDECIMALDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT)) + (#.+char-attr-constituent-dot+ (go MIDDLEDOT)) + (#.+char-attr-constituent-expt+ (go EXPONENT)) + (#.+char-attr-constituent-slash+ (aver (not possibly-rational)) + (go SYMBOL)) + (#.+char-attr-delimiter+ (unread-char char stream) + (go RETURN-SYMBOL)) + (#.+char-attr-escape+ (go ESCAPE)) + (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) + (#.+char-attr-package-delimiter+ (go COLON)) + (t (go SYMBOL))) MIDDLEDOT ; saw "[sign] {digit}+ dot" (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (return (let ((*read-base* 10)) (make-integer)))) (case (char-class char attribute-table) - (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go RIGHTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-expt+ (go EXPONENT)) (#.+char-attr-delimiter+ (unread-char char stream) @@ -798,12 +826,15 @@ (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) (#.+char-attr-package-delimiter+ (go COLON)) (t (go SYMBOL))) - RIGHTDIGIT ; saw "[sign] {digit}* dot {digit}+" + RIGHTDIGIT ; saw "[sign] {decimal-digit}* dot {digit}+" (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (return (make-float stream))) (case (char-class char attribute-table) - (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go RIGHTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-expt+ (go EXPONENT)) (#.+char-attr-delimiter+ (unread-char char stream) @@ -817,7 +848,10 @@ (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) (case (char-class char attribute-table) - (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go RIGHTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) @@ -827,7 +861,10 @@ (setq char (read-char stream nil nil)) (unless char (%reader-error stream "dot context error")) (case (char-class char attribute-table) - (#.+char-attr-constituent-digit+ (go RIGHTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go RIGHTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT)) (#.+char-attr-constituent-dot+ (go DOTS)) (#.+char-attr-delimiter+ (%reader-error stream "dot context error")) (#.+char-attr-escape+ (go ESCAPE)) @@ -838,9 +875,13 @@ (ouch-read-buffer char) (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) + (setq possibly-float t) (case (char-class char attribute-table) (#.+char-attr-constituent-sign+ (go EXPTSIGN)) - (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go EXPTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) @@ -851,7 +892,10 @@ (setq char (read-char stream nil nil)) (unless char (go RETURN-SYMBOL)) (case (char-class char attribute-table) - (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go EXPTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (go RETURN-SYMBOL)) (#.+char-attr-escape+ (go ESCAPE)) (#.+char-attr-multiple-escape+ (go MULT-ESCAPE)) @@ -862,7 +906,10 @@ (setq char (read-char stream nil nil)) (unless char (return (make-float stream))) (case (char-class char attribute-table) - (#.+char-attr-constituent-digit+ (go EXPTDIGIT)) + (#.+char-attr-constituent-digit+ (if possibly-float + (go EXPTDIGIT) + (go SYMBOL))) + (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT)) (#.+char-attr-delimiter+ (unread-char char stream) (return (make-float stream))) diff --git a/src/code/readtable.lisp b/src/code/readtable.lisp index 3764b16..ee4dd7a 100644 --- a/src/code/readtable.lisp +++ b/src/code/readtable.lisp @@ -26,6 +26,9 @@ (def!constant +char-attr-constituent-digit+ 7) (def!constant +char-attr-constituent-sign+ 8) ;; the "9" entry intentionally left blank for some reason -- WHN 19990806 +;; +;; appropriated by CSR 2004-03-16 +(def!constant +char-attr-constituent-decimal-digit+ 9) (def!constant +char-attr-multiple-escape+ 10) (def!constant +char-attr-package-delimiter+ 11) (def!constant +char-attr-delimiter+ 12) ; (a fake for READ-UNQUALIFIED-TOKEN) diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp index 33af266..268d77e 100644 --- a/tests/reader.pure.lisp +++ b/tests/reader.pure.lisp @@ -107,3 +107,64 @@ (assert (equal (multiple-value-list (parse-integer string)) '(123 6)))) + +(let ((*read-base* *read-base*)) + (dolist (float-string '(".9" ".9e9" ".9e+9" ".9e-9" + "-.9" "-.9e9" "-.9e+9" "-.9e-9" + "+.9" "+.9e9" "+.9e+9" "+.9e-9" + "0.9" "0.9e9" "0.9e+9" "0.9e-9" + "9.09" "9.09e9" "9.09e+9" "9.09e-9" + "9e9" "9e+9" "9e-9")) + (loop for i from 2 to 36 + do (setq *read-base* i) + do (assert (typep (read-from-string float-string) + *read-default-float-format*)) + do (assert (typep + (read-from-string (substitute #\E #\e float-string)) + *read-default-float-format*)) + if (position #\e float-string) + do (assert (typep + (read-from-string (substitute #\s #\e float-string)) + 'short-float)) + and do (assert (typep + (read-from-string (substitute #\S #\e float-string)) + 'short-float)) + and do (assert (typep + (read-from-string (substitute #\f #\e float-string)) + 'single-float)) + and do (assert (typep + (read-from-string (substitute #\F #\e float-string)) + 'single-float)) + and do (assert (typep + (read-from-string (substitute #\d #\e float-string)) + 'double-float)) + and do (assert (typep + (read-from-string (substitute #\D #\e float-string)) + 'double-float)) + and do (assert (typep + (read-from-string (substitute #\d #\e float-string)) + 'long-float)) + and do (assert (typep + (read-from-string (substitute #\D #\e float-string)) + 'long-float))))) + +(let ((*read-base* *read-base*)) + (dolist (integer-string '("1." "2." "3." "4." "5." "6." "7." "8." "9." "0.")) + (loop for i from 2 to 36 + do (setq *read-base* i) + do (assert (typep (read-from-string integer-string) 'integer))))) + +(let ((*read-base* *read-base*)) + (dolist (symbol-string '("A." "a." "Z." "z." + + "+.9eA" "+.9ea" + + "0.A" "0.a" "0.Z" "0.z" + + "9eA" "9ea" "9e+A" "9e+a" "9e-A" "9e-a" + "Ae9" "ae9" "Ae+9" "ae+9" "Ae-9" "ae-9" + + "A.0" "A.0e10" "a.0" "a.0e10")) + (loop for i from 2 to 36 + do (setq *read-base* i) + do (assert (typep (read-from-string symbol-string) 'symbol))))) diff --git a/version.lisp-expr b/version.lisp-expr index 1efb96d..500acb2 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.8.26" +"0.8.8.27"