From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Tue, 16 Mar 2004 18:00:04 +0000 (+0000)
Subject: 0.8.8.28:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=abecd31762c38b078077ebbfbadb51139dee6059;p=sbcl.git

0.8.8.28:
	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.
---

diff --git a/NEWS b/NEWS
index 95c3d37..6a840a1 100644
--- 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
diff --git a/src/code/reader.lisp b/src/code/reader.lisp
index 4980544..7fc9cd1 100644
--- a/src/code/reader.lisp
+++ b/src/code/reader.lisp
@@ -658,7 +658,9 @@
 	 +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))))
 
@@ -735,7 +737,9 @@
 	(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)
@@ -743,6 +747,9 @@
       (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))
@@ -758,6 +765,9 @@
 	    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))
@@ -769,6 +779,7 @@
       (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
@@ -777,7 +788,34 @@
 	(#.+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)))
@@ -792,11 +830,8 @@
       (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))
@@ -813,10 +848,7 @@
       (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)
@@ -831,10 +863,7 @@
       (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)
@@ -848,10 +877,7 @@
       (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))
@@ -861,10 +887,7 @@
       (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))
@@ -878,10 +901,7 @@
       (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))
@@ -892,10 +912,7 @@
       (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))
@@ -906,10 +923,7 @@
       (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)))
diff --git a/src/code/readtable.lisp b/src/code/readtable.lisp
index ee4dd7a..597d8ce 100644
--- a/src/code/readtable.lisp
+++ b/src/code/readtable.lisp
@@ -25,13 +25,18 @@
 (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)
diff --git a/tests/reader.pure.lisp b/tests/reader.pure.lisp
index 268d77e..3a54591 100644
--- a/tests/reader.pure.lisp
+++ b/tests/reader.pure.lisp
@@ -114,7 +114,7 @@
 			  "+.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)
@@ -142,10 +142,10 @@
 			  (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*))
@@ -161,10 +161,15 @@
 			   
 			   "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)))))
diff --git a/version.lisp-expr b/version.lisp-expr
index 500acb2..8edb825 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.27"
+"0.8.8.28"