0.8.8.28:
authorChristophe Rhodes <csr21@cam.ac.uk>
Tue, 16 Mar 2004 18:00:04 +0000 (18:00 +0000)
committerChristophe Rhodes <csr21@cam.ac.uk>
Tue, 16 Mar 2004 18:00:04 +0000 (18:00 +0000)
More floating point reader fixes for non-10 *READ-BASE*
... confusion arises if the exponent marker is also a digit.
Fix the manifest confusions;
... also a long-standing floating point reader-bugfix: reading
"ae+9" with *READ-BASE* = 11 used to give a BUG;
... fix the tests, too.

NEWS
src/code/reader.lisp
src/code/readtable.lisp
tests/reader.pure.lisp
version.lisp-expr

diff --git a/NEWS b/NEWS
index 95c3d37..6a840a1 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2356,6 +2356,8 @@ changes in sbcl-0.8.9 relative to sbcl-0.8.8:
        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.
+    ** Reading floating-point numbers with *READ-BASE* set to a number
+       more than 10 works correctly.
 
 planned incompatible changes in 0.8.x:
   * (not done yet, but planned:) When the profiling interface settles
index 4980544..7fc9cd1 100644 (file)
         +char-attr-delimiter+
         (if (digit-char-p ,char (max *read-base* 10))
             (if (digit-char-p ,char *read-base*)
-                +char-attr-constituent-digit+
+                (if (= att +char-attr-constituent-expt+)
+                    +char-attr-constituent-digit-or-expt+
+                    +char-attr-constituent-digit+)
                 +char-attr-constituent-decimal-digit+)
             att))))
 \f
        (package-designator nil)
        (colons 0)
        (possibly-rational t)
+       (seen-digit-or-expt nil)
        (possibly-float t)
+       (was-possibly-float nil)
        (escapes ())
        (seen-multiple-escapes nil))
     (reset-read-buffer)
       (case (char-class3 char attribute-table)
        (#.+char-attr-constituent-sign+ (go SIGN))
        (#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+       (#.+char-attr-constituent-digit-or-expt+
+        (setq seen-digit-or-expt t)
+        (go LEFTDIGIT))
        (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT))
        (#.+char-attr-constituent-dot+ (go FRONTDOT))
        (#.+char-attr-escape+ (go ESCAPE))
            possibly-float t)
       (case (char-class3 char attribute-table)
        (#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+       (#.+char-attr-constituent-digit-or-expt+
+        (setq seen-digit-or-expt t)
+        (go LEFTDIGIT))
        (#.+char-attr-constituent-decimal-digit+ (go LEFTDECIMALDIGIT))
        (#.+char-attr-constituent-dot+ (go SIGNDOT))
        (#.+char-attr-escape+ (go ESCAPE))
       (ouch-read-buffer char)
       (setq char (read-char stream nil nil))
       (unless char (return (make-integer)))
+      (setq was-possibly-float possibly-float)
       (case (char-class3 char attribute-table)
        (#.+char-attr-constituent-digit+ (go LEFTDIGIT))
        (#.+char-attr-constituent-decimal-digit+ (if possibly-float
        (#.+char-attr-constituent-dot+ (if possibly-float
                                           (go MIDDLEDOT)
                                           (go SYMBOL)))
-       (#.+char-attr-constituent-expt+ (go EXPONENT))
+       (#.+char-attr-constituent-digit-or-expt+
+        (if (or seen-digit-or-expt (not was-possibly-float))
+            (progn (setq seen-digit-or-expt t) (go LEFTDIGIT))
+            (progn (setq seen-digit-or-expt t) (go LEFTDIGIT-OR-EXPT))))
+       (#.+char-attr-constituent-expt+
+        (if was-possibly-float
+            (go EXPONENT)
+            (go SYMBOL)))
+       (#.+char-attr-constituent-slash+ (if possibly-rational
+                                            (go RATIO)
+                                            (go SYMBOL)))
+       (#.+char-attr-delimiter+ (unread-char char stream)
+                                (return (make-integer)))
+       (#.+char-attr-escape+ (go ESCAPE))
+       (#.+char-attr-multiple-escape+ (go MULT-ESCAPE))
+       (#.+char-attr-package-delimiter+ (go COLON))
+       (t (go SYMBOL)))
+     LEFTDIGIT-OR-EXPT
+      (ouch-read-buffer char)
+      (setq char (read-char stream nil nil))
+      (unless char (return (make-integer)))
+      (case (char-class3 char attribute-table)
+       (#.+char-attr-constituent-digit+ (go LEFTDIGIT))
+       (#.+char-attr-constituent-decimal-digit+ (bug "impossible!"))
+       (#.+char-attr-constituent-dot+ (go SYMBOL))
+       (#.+char-attr-constituent-digit-or-expt+ (go LEFTDIGIT))
+       (#.+char-attr-constituent-expt+ (go SYMBOL))
+       (#.+char-attr-constituent-sign+ (go EXPTSIGN))
        (#.+char-attr-constituent-slash+ (if possibly-rational
                                             (go RATIO)
                                             (go SYMBOL)))
       (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))
+      (case (char-class char attribute-table)
+       (#.+char-attr-constituent-digit+ (go LEFTDECIMALDIGIT))
        (#.+char-attr-constituent-dot+ (go MIDDLEDOT))
        (#.+char-attr-constituent-expt+ (go EXPONENT))
        (#.+char-attr-constituent-slash+ (aver (not possibly-rational))
       (unless char (return (let ((*read-base* 10))
                             (make-integer))))
       (case (char-class char attribute-table)
-       (#.+char-attr-constituent-digit+ (if possibly-float
-                                            (go RIGHTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+       (#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
        (#.+char-attr-constituent-expt+ (go EXPONENT))
        (#.+char-attr-delimiter+
         (unread-char char stream)
       (setq char (read-char stream nil nil))
       (unless char (return (make-float stream)))
       (case (char-class char attribute-table)
-       (#.+char-attr-constituent-digit+ (if possibly-float
-                                            (go RIGHTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+       (#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
        (#.+char-attr-constituent-expt+ (go EXPONENT))
        (#.+char-attr-delimiter+
         (unread-char char stream)
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-       (#.+char-attr-constituent-digit+ (if possibly-float
-                                            (go RIGHTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+       (#.+char-attr-constituent-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))
       (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+ (if possibly-float
-                                            (go RIGHTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go RIGHTDIGIT))
+       (#.+char-attr-constituent-digit+ (go RIGHTDIGIT))
        (#.+char-attr-constituent-dot+ (go DOTS))
        (#.+char-attr-delimiter+  (%reader-error stream "dot context error"))
        (#.+char-attr-escape+ (go ESCAPE))
       (setq possibly-float t)
       (case (char-class char attribute-table)
        (#.+char-attr-constituent-sign+ (go EXPTSIGN))
-       (#.+char-attr-constituent-digit+ (if possibly-float
-                                            (go EXPTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT))
+       (#.+char-attr-constituent-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))
       (setq char (read-char stream nil nil))
       (unless char (go RETURN-SYMBOL))
       (case (char-class char attribute-table)
-       (#.+char-attr-constituent-digit+ (if possibly-float
-                                            (go EXPTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT))
+       (#.+char-attr-constituent-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))
       (setq char (read-char stream nil nil))
       (unless char (return (make-float stream)))
       (case (char-class char attribute-table)
-       (#.+char-attr-constituent-digit+ (if possibly-float
-                                            (go EXPTDIGIT)
-                                            (go SYMBOL)))
-       (#.+char-attr-constituent-decimal-digit+ (go EXPTDIGIT))
+       (#.+char-attr-constituent-digit+ (go EXPTDIGIT))
        (#.+char-attr-delimiter+
         (unread-char char stream)
         (return (make-float stream)))
index ee4dd7a..597d8ce 100644 (file)
 (def!constant +char-attr-constituent-slash+ 6)
 (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
+;;; the following two are not static but depend on *READ-BASE*.
+;;; DECIMAL-DIGIT is for characters being digits in base 10 but not in
+;;; base *READ-BASE* (which is therefore perforce smaller than 10);
+;;; DIGIT-OR-EXPT is for characters being both exponent markers and
+;;; digits in base *READ-BASE* (which is therefore perforce larger
+;;; than 10).  -- 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)
+(def!constant +char-attr-constituent-digit-or-expt+ 10)
+
+(def!constant +char-attr-multiple-escape+ 11)
+(def!constant +char-attr-package-delimiter+ 12)
+(def!constant +char-attr-delimiter+ 13) ; (a fake for READ-UNQUALIFIED-TOKEN)
 
 (sb!xc:defstruct (readtable (:conc-name nil)
                            (:predicate readtablep)
index 268d77e..3a54591 100644 (file)
                          "+.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"))
+                         #|"9e9" could be integer|# "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-from-string (substitute #\D #\e float-string))
                          'double-float))
          and do (assert (typep
-                         (read-from-string (substitute #\d #\e float-string))
+                         (read-from-string (substitute #\l #\e float-string))
                          'long-float))
          and do (assert (typep
-                         (read-from-string (substitute #\D #\e float-string))
+                         (read-from-string (substitute #\L #\e float-string))
                          'long-float)))))
 
 (let ((*read-base* *read-base*))
                           
                           "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"))
+                          #|"9eA" "9ea"|# "9e+A" "9e+a" "9e-A" "9e-a"
+                          #|"Ae9" "ae9"|# "Ae+9" "ae+9" "Ae-9" "ae-9"
+
+                          "ee+9" "Ee+9" "eE+9" "EE+9"
+                          "ee-9" "Ee-9" "eE-9" "EE-9"
+
+                          "A.0" "A.0e10" "a.0" "a.0e10"
+
+                          "1e1e+9"))
     (loop for i from 2 to 36
          do (setq *read-base* i)
          do (assert (typep (read-from-string symbol-string) 'symbol)))))
index 500acb2..8edb825 100644 (file)
@@ -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.27"
+"0.8.8.28"