~ chicken-core (chicken-5) a86ed010d019e6dafa98d6af94e40a44a6bef983

commit a86ed010d019e6dafa98d6af94e40a44a6bef983
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Wed Sep 12 22:25:54 2012 +0200
Commit:     Peter Bex <peter.bex@xs4all.nl>
CommitDate: Fri Sep 14 20:44:28 2012 +0200

    Detect keywords that start with numbers or dot correctly.
    
    This was reported by Moritz and Christian and was caused by
    using the wrong internal token-reader function when a token
    started with a digit or #\. - this implies the #\. inside
    a dotted list.
    
    Signed-off-by: Peter Bex <peter.bex@xs4all.nl>

diff --git a/library.scm b/library.scm
index 76eb046f..bb30f392 100644
--- a/library.scm
+++ b/library.scm
@@ -2553,15 +2553,20 @@ EOF
 					    (starting-line "missing list terminator")
 					    end) ) ]
 					[else
-					 (let* ((tok (##sys#string-append "." (r-token)))
-						(n (and (char-numeric? c2) 
-							(##sys#string->number tok)))
-						(val (or n (build-symbol tok))) 
-						(node (cons val '())) )
-					   (if first 
-					       (##sys#setslot last 1 node)
-					       (set! first node) )
-					   (loop node) ) ] ) ) )
+					 (r-xtoken
+					  (lambda (tok kw)
+					    (let* ((tok (##sys#string-append "." tok))
+						   (val
+						    (if kw
+							(build-keyword tok)
+							(or (and (char-numeric? c2) 
+								 (##sys#string->number tok))
+							    (build-symbol tok))))
+						   (node (cons val '())) )
+					      (if first 
+						  (##sys#setslot last 1 node)
+						  (set! first node) )
+					      (loop node) ))) ] ) ) )
 			       (else
 				(let ([node (cons (readrec) '())])
 				  (if first
@@ -2582,22 +2587,25 @@ EOF
 	  
 	  (define (r-number radix exactness)
 	    (set! rat-flag #f)
-	    (let ((tok (r-token)))
-	      (cond
-		((string=? tok ".")
-                 (##sys#read-error port "invalid use of `.'"))
-		((and (fx> (##sys#size tok) 0) (char=? (string-ref tok 0) #\#))
-                 (##sys#read-error port "unexpected prefix in number syntax" tok))
-		(else
-                 (let ((val (##sys#string->number tok (or radix 10) exactness)) )
-                   (cond (val
-                          (when (and (##sys#inexact? val) (not (eq? exactness 'i)) rat-flag)
-                            (##sys#read-warning
-                             port
-                             "cannot represent exact fraction - coerced to flonum" tok) )
-                          val)
-                         (radix (##sys#read-error port "illegal number syntax" tok))
-                         (else (build-symbol tok)) ) ) ) ) ) )
+	    (r-xtoken
+	     (lambda (tok kw)
+	       (cond (kw
+		      (let ((s (build-keyword tok)))
+			(info 'symbol-info s (##sys#port-line port)) ))
+		     ((string=? tok ".")
+		      (##sys#read-error port "invalid use of `.'"))
+		     ((and (fx> (##sys#size tok) 0) (char=? (string-ref tok 0) #\#))
+		      (##sys#read-error port "unexpected prefix in number syntax" tok))
+		     (else
+		      (let ((val (##sys#string->number tok (or radix 10) exactness)) )
+			(cond (val
+			       (when (and (##sys#inexact? val) (not (eq? exactness 'i)) rat-flag)
+				 (##sys#read-warning
+				  port
+				  "cannot represent exact fraction - coerced to flonum" tok) )
+			       val)
+			      (radix (##sys#read-error port "illegal number syntax" tok))
+			      (else (build-symbol tok)) ) ) ) ) ) ))
 
 	  (define (r-number-with-exactness radix)
 	    (cond [(char=? #\# (##sys#peek-char-0 port))
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index c986ef16..c385c1be 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -300,6 +300,12 @@
 (assert (string=? ":" (symbol->string (with-input-from-string ":||" read))))
 (assert-fail (with-input-from-string "#:" read))
 
+(assert (keyword? (with-input-from-string "42:" read)))
+(assert (keyword? (with-input-from-string ".:" read)))
+
+(assert (equal? (cons 1 2) (with-input-from-string "(1 . 2)" read)))
+(assert (every keyword? (with-input-from-string "(42: abc: .: #:: ::)" read)))
+
 
 ;;; setters