From 3b1eca1c2173bfde3860cec21cf084d5d2d6abf8 Mon Sep 17 00:00:00 2001 From: Peter Bex Date: Sat, 29 Jun 2019 16:48:13 +0200 Subject: [PATCH 1/2] 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 --- NEWS | 6 ++++ library.scm | 88 +++++++++++++++++++++++++------------------------ tests/library-tests.scm | 38 ++++++++++++++------- 3 files changed, 78 insertions(+), 54 deletions(-) diff --git a/NEWS b/NEWS index e15ec4e3..2ebee3f0 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,11 @@ 5.1.1 +- 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 994efc4d..78b92a1f 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)) -- 2.11.0