~ chicken-core (chicken-5) a83213c4604239365ac3cd4b02f1e61bdd09c92c

commit a83213c4604239365ac3cd4b02f1e61bdd09c92c
Author:     alice maz <alice@alicemaz.com>
AuthorDate: Wed Aug 5 00:07:23 2020 -0500
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Wed Sep 9 22:21:14 2020 +1200

    Always treat bare colon as a symbol
    
    Fixes ##sys#read behavior in -keyword-style prefix to match suffix.
    
    Also fixes it to consume at most one colon in -keyword-style prefix.
    
    Fixes #1711.
    
    Signed-off-by: megane <meganeka@gmail.com>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/library.scm b/library.scm
index c5015b7a..ab3b6397 100644
--- a/library.scm
+++ b/library.scm
@@ -4031,15 +4031,18 @@ EOF
 		(cond ((or (eof-object? c)
 			   (char-whitespace? c)
 			   (memq c terminating-characters))
-		       ;; The not null? checks here ensure we read a
-		       ;; plain ":" as a symbol, not as a keyword.
-		       ;; However, when the keyword is quoted like ||:,
-		       ;; it _should_ be read as a keyword.
-		       (if (and skw (eq? ksp #:suffix)
-				(or qtd (not (null? (cdr lst)))))
-			   (k (##sys#reverse-list->string (cdr lst)) #t)
-			   (k (##sys#reverse-list->string lst)
-			      (and pkw (or qtd (not (null? lst)))))))
+		       ;; The various cases here cover:
+		       ;; - Nonempty keywords formed with colon in the ksp position
+		       ;; - Empty keywords formed explicitly with vbar quotes
+		       ;; - Bare colon, which should always be a symbol
+		       (cond ((and skw (eq? ksp #:suffix) (or qtd (not (null? (cdr lst)))))
+			      (k (##sys#reverse-list->string (cdr lst)) #t))
+			     ((and pkw (eq? ksp #:prefix) (or qtd (not (null? lst))))
+			      (k (##sys#reverse-list->string lst) #t))
+			     ((and pkw (eq? ksp #:prefix) (not qtd) (null? lst))
+			      (k ":" #f))
+			     (else
+			      (k (##sys#reverse-list->string lst) #f))))
 		      ((memq c reserved-characters)
 		       (reserved-character c))
 		      (else
@@ -4056,6 +4059,7 @@ EOF
 			    (loop (cons #\newline lst) pkw #f qtd))
 			   ((#\:)
 			    (cond ((and (null? lst)
+					(not pkw)
 					(not qtd)
 					(eq? ksp #:prefix))
 				   (loop '() #t #f qtd))
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index dda075f7..d331871e 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -496,10 +496,17 @@
   (assert (not (keyword? (with-input-from-string ":abc:" read))))
   (assert (not (keyword? (with-input-from-string "abc:" read)))))
 
-(let ((colon-sym (with-input-from-string ":" read)))
-  (assert (symbol? colon-sym))
-  (assert (not (keyword? colon-sym)))
-  (assert (string=? ":" (symbol->string colon-sym))))
+(parameterize ((keyword-style #:suffix))
+  (let ((colon-sym (with-input-from-string ":" read)))
+    (assert (symbol? colon-sym))
+    (assert (not (keyword? colon-sym)))
+    (assert (string=? ":" (symbol->string colon-sym)))))
+
+(parameterize ((keyword-style #:prefix))
+  (let ((colon-sym (with-input-from-string ":" read)))
+    (assert (symbol? colon-sym))
+    (assert (not (keyword? colon-sym)))
+    (assert (string=? ":" (symbol->string colon-sym)))))
 
 ;; The next two cases are a bit dubious, but we follow SRFI-88 (see
 ;; also #1625).