~ chicken-core (chicken-5) 287864501aea35a32d524aaf1f174938bc5b223d
commit 287864501aea35a32d524aaf1f174938bc5b223d
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sat Jun 29 16:48:13 2019 +0200
Commit: Evan Hanson <evhan@foldling.org>
CommitDate: Fri Jul 12 20:57:29 2019 +1200
Read quoted empty keywords as keywords
This also fixes a long-standing weird edge case marked with "XXX" in the
test suite where abc:|| would be read as a keyword in suffix mode.
Fixes #1625
Signed-off-by: Evan Hanson <evhan@foldling.org>
diff --git a/NEWS b/NEWS
index f7c5413c..60e7551b 100644
--- a/NEWS
+++ b/NEWS
@@ -5,6 +5,12 @@
semi-space bytes like the documentation says. Old implementation
returned full-heap size and (full-heap - used-semi-space).
+- Runtime system
+ - Quoted empty keywords like ||: and :|| are now read like prescribed
+ by SRFI-88 in the corresponding keyword mode. Symbols containing
+ quoted empty prefixes or suffixes like ||abc: and abc:|| will be
+ read correctly as symbols now (fixes #1625, thanks to Andy Bennett).
+
- Compiler
- Fixed a bug in lfa2 pass which caused "if" or "cond" nodes to be
incorrectly unboxed if the "else" branch had a flonum result type
diff --git a/library.scm b/library.scm
index 998b438c..4e34d6ec 100644
--- a/library.scm
+++ b/library.scm
@@ -4016,49 +4016,51 @@ EOF
(info 'symbol-info s (##sys#port-line port)) ) )))
(define (r-xtoken k)
- (let ((pkw #f))
- (let loop ((lst '()) (skw #f))
- (let ((c (##sys#peek-char-0 port)))
- (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.
- (if (and skw (eq? ksp #:suffix)
- (not (null? (cdr lst))))
- (k (##sys#reverse-list->string (cdr lst)) #t)
- (k (##sys#reverse-list->string lst)
- (and pkw (not (null? lst))))))
- ((memq c reserved-characters)
- (reserved-character c))
- (else
- (let ((c (##sys#read-char-0 port)))
- (case c
- ((#\|)
- (let ((part (r-string #\|)))
- (loop (append (##sys#fast-reverse (##sys#string->list part)) lst)
- #f)))
- ((#\newline)
- (##sys#read-warning
- port "escaped symbol syntax spans multiple lines"
- (##sys#reverse-list->string lst))
- (loop (cons #\newline lst) #f))
- ((#\:)
- (cond ((and (null? lst) (eq? ksp #:prefix))
- (set! pkw #t)
- (loop '() #f))
- (else (loop (cons #\: lst) #t))))
- ((#\\)
- (let ((c (##sys#read-char-0 port)))
- (if (eof-object? c)
- (##sys#read-error
- port
- "unexpected end of file while reading escaped character")
- (loop (cons c lst) #f))))
- (else
- (loop
- (cons (if csp c (char-downcase c)) lst)
- #f))))))))))
+ (let loop ((lst '()) (pkw #f) (skw #f) (qtd #f))
+ (let ((c (##sys#peek-char-0 port)))
+ (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)))))))
+ ((memq c reserved-characters)
+ (reserved-character c))
+ (else
+ (let ((c (##sys#read-char-0 port)))
+ (case c
+ ((#\|)
+ (let ((part (r-string #\|)))
+ (loop (append (##sys#fast-reverse (##sys#string->list part)) lst)
+ pkw #f #t)))
+ ((#\newline)
+ (##sys#read-warning
+ port "escaped symbol syntax spans multiple lines"
+ (##sys#reverse-list->string lst))
+ (loop (cons #\newline lst) pkw #f qtd))
+ ((#\:)
+ (cond ((and (null? lst)
+ (not qtd)
+ (eq? ksp #:prefix))
+ (loop '() #t #f qtd))
+ (else (loop (cons #\: lst) pkw #t qtd))))
+ ((#\\)
+ (let ((c (##sys#read-char-0 port)))
+ (if (eof-object? c)
+ (##sys#read-error
+ port
+ "unexpected end of file while reading escaped character")
+ (loop (cons c lst) pkw #f qtd))))
+ (else
+ (loop
+ (cons (if csp c (char-downcase c)) lst)
+ pkw #f qtd)))))))))
(define (r-char)
;; Code contributed by Alex Shinn
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index eb380d73..8d9e3b24 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -449,6 +449,7 @@
(parameterize ((keyword-style #:suffix))
(assert (keyword? (with-input-from-string "abc:" read)))
(assert (keyword? (with-input-from-string "|abc|:" read)))
+ (assert (keyword? (with-input-from-string "a|bc|d:" read)))
(assert (not (keyword? (with-input-from-string "abc:||" read))))
(assert (not (keyword? (with-input-from-string "abc\\:" read))))
(assert (not (keyword? (with-input-from-string "abc|:|" read))))
@@ -457,12 +458,15 @@
(parameterize ((keyword-style #:prefix))
(assert (keyword? (with-input-from-string ":abc" read)))
(assert (keyword? (with-input-from-string ":|abc|" read)))
- (assert (keyword? (with-input-from-string "||:abc" read))) ;XXX should be not
+ (assert (keyword? (with-input-from-string ":a|bc|d" read)))
+ (assert (not (keyword? (with-input-from-string "||:abc" read))))
(assert (not (keyword? (with-input-from-string "\\:abc" read))))
(assert (not (keyword? (with-input-from-string "|:|abc" read))))
(assert (not (keyword? (with-input-from-string "|:abc|" read)))))
(parameterize ((keyword-style #f))
+ (assert (not (keyword? (with-input-from-string ":||" read))))
+ (assert (not (keyword? (with-input-from-string "||:" read))))
(assert (not (keyword? (with-input-from-string ":abc" read))))
(assert (not (keyword? (with-input-from-string ":abc:" read))))
(assert (not (keyword? (with-input-from-string "abc:" read)))))
@@ -472,17 +476,29 @@
(assert (not (keyword? colon-sym)))
(assert (string=? ":" (symbol->string colon-sym))))
-;; The next two cases are a bit dubious. These could also be read as
-;; keywords due to the literal quotation.
-(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).
+(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))))
-(let ((colon-sym (with-input-from-string "||:" read)))
- (assert (symbol? colon-sym))
- (assert (not (keyword? colon-sym)))
- (assert (string=? ":" (symbol->string colon-sym))))
+ (let ((empty-kw (with-input-from-string "||:" read)))
+ (assert (not (symbol? empty-kw)))
+ (assert (keyword? empty-kw))
+ (assert (string=? "" (keyword->string empty-kw)))))
+
+(parameterize ((keyword-style #:prefix))
+ (let ((empty-kw (with-input-from-string ":||" read)))
+ (assert (not (symbol? empty-kw)))
+ (assert (keyword? empty-kw))
+ (assert (string=? "" (keyword->string empty-kw))))
+
+ (let ((colon-sym (with-input-from-string "||:" read)))
+ (assert (symbol? colon-sym))
+ (assert (not (keyword? colon-sym)))
+ (assert (string=? ":" (symbol->string colon-sym)))))
(assert-fail (with-input-from-string "#:" read))
Trap