~ chicken-core (chicken-5) eac328cd59708ded9336ff737362865b4217b0f5
commit eac328cd59708ded9336ff737362865b4217b0f5
Author: Peter Bex <peter@more-magic.net>
AuthorDate: Sun May 26 13:45:44 2019 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jun 3 12:12:14 2019 +0200
Always pipe-quote symbols starting or ending with a colon
This is necessary, as shown by the failure of the srfi-128 egg: this
egg is compiled with keyword-style #:none in the compiler, which would
mean the types file emitted contains symbols like :type-test:, which
is read as a keyword when either other keyword style is set (and the
default is suffix). All s-expressions written by one program should
be readable by another program, regardless of keyword style.
Signed-off-by: felix <felix@call-with-current-continuation.org>
diff --git a/NEWS b/NEWS
index 84505a56..947527a1 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,10 @@
5.0.3
+- Core libraries
+ - Symbols ending or starting with a colon are now always pipe-quoted
+ when written by `write` to ensure they can be read back with a
+ different keyword-style setting.
+
- Runtime system
- Keywords are now distinct types; they are not a subtype of symbols.
- Use arc4random on FreeBSD (thanks to Tobias Kortkamp and gahr)
diff --git a/library.scm b/library.scm
index 3716fe52..b7d0c10e 100644
--- a/library.scm
+++ b/library.scm
@@ -4505,7 +4505,7 @@ EOF
(eq? c #\.)
(eq? c #\-) )
(not (##sys#string->number str)) )
- ((eq? c #\:) (not (eq? ksp #:prefix)))
+ ((eq? c #\:) #f)
((and (eq? c #\#)
;; Not a qualified symbol?
(not (and (fx> len 2)
@@ -4518,8 +4518,7 @@ EOF
(and (or csp (not (char-upper-case? c)))
(not (specialchar? c))
(or (not (eq? c #\:))
- (fx< i (fx- len 1))
- (not (eq? ksp #:suffix)))
+ (fx< i (fx- len 1)))
(loop (fx- i 1)) ) ) ) ) ) ) ) )
(let out ([x x])
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index fa56e820..eb380d73 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -291,7 +291,6 @@
(write (string->symbol "3"))))
read)))
-
;;; escaped symbol syntax
(assert (string=? "abc" (symbol->string '|abc|)))
@@ -349,24 +348,99 @@
(parameterize ((keyword-style #:suffix))
(assert (string=? "abc:" (symbol->string (with-input-from-string "|abc:|" read))))
(assert (string=? "abc" (keyword->string (with-input-from-string "|abc|:" read)))) ; keyword
- (let ((kw (with-input-from-string "|foo bar|:" read)))
+ (let ((kw (with-input-from-string "|foo bar|:" read))
+ (sym1 (with-input-from-string "|foo:|" read))
+ (sym2 (with-input-from-string "|:foo|" read)))
+
+ (assert (symbol? sym1))
+ (assert (not (keyword? sym1)))
+
+ (assert (symbol? sym2))
+ (assert (not (keyword? sym2)))
+
+ (assert (keyword? kw))
+ (assert (not (symbol? kw)))
+
(assert (eq? kw (with-input-from-string "#:|foo bar|" read)))
(assert (string=? "foo bar" (keyword->string kw)))
+ (assert (string=? "foo:" (symbol->string sym1)))
+ (assert (string=? ":foo" (symbol->string sym2)))
+
(assert (string=? "foo bar:"
(with-output-to-string (lambda () (display kw)))))
(assert (string=? "#:|foo bar|"
- (with-output-to-string (lambda () (write kw)))))))
+ (with-output-to-string (lambda () (write kw)))))
+
+ (assert (string=? "|foo:|"
+ (with-output-to-string (lambda () (write sym1)))))
+ ;; Regardless of keyword style, symbols must be quoted to avoid
+ ;; issues when reading it back with a different keyword style.
+ (assert (string=? "|:foo|"
+ (with-output-to-string (lambda () (write sym2)))))))
(parameterize ((keyword-style #:prefix))
(assert (string=? "abc" (keyword->string (with-input-from-string ":|abc|" read))))
(assert (string=? ":abc" (symbol->string (with-input-from-string "|:abc|" read))))
- (let ((kw (with-input-from-string ":|foo bar|" read)))
+ (let ((kw (with-input-from-string ":|foo bar|" read))
+ (sym1 (with-input-from-string "|:foo|" read))
+ (sym2 (with-input-from-string "|foo:|" read)))
+
+ (assert (symbol? sym1))
+ (assert (not (keyword? sym1)))
+
+ (assert (symbol? sym2))
+ (assert (not (keyword? sym2)))
+
+ (assert (keyword? kw))
+ (assert (not (symbol? kw)))
+
(assert (eq? kw (with-input-from-string "#:|foo bar|" read)))
(assert (string=? "foo bar" (keyword->string kw)))
+ (assert (string=? ":foo" (symbol->string sym1)))
+ (assert (string=? "foo:" (symbol->string sym2)))
+
(assert (string=? ":foo bar"
(with-output-to-string (lambda () (display kw)))))
(assert (string=? "#:|foo bar|"
- (with-output-to-string (lambda () (write kw)))))))
+ (with-output-to-string (lambda () (write kw)))))
+
+ (assert (string=? "|:foo|"
+ (with-output-to-string (lambda () (write sym1)))))
+ ;; Regardless of keyword style, symbols must be quoted to avoid
+ ;; issues when reading it back with a different keyword style.
+ (assert (string=? "|foo:|"
+ (with-output-to-string (lambda () (write sym2)))))))
+
+(parameterize ((keyword-style #:none))
+ (let ((kw (with-input-from-string "#:|foo bar|" read))
+ (sym1 (with-input-from-string "|:foo|" read))
+ (sym2 (with-input-from-string "|foo:|" read)))
+
+ (assert (symbol? sym1))
+ (assert (not (keyword? sym1)))
+
+ (assert (symbol? sym2))
+ (assert (not (keyword? sym2)))
+
+ (assert (keyword? kw))
+ (assert (not (symbol? kw)))
+
+ (assert (eq? kw (string->keyword "foo bar"))
+ (assert (string=? "foo bar" (keyword->string kw)))
+ (assert (string=? ":foo" (symbol->string sym1)))
+ (assert (string=? "foo:" (symbol->string sym2)))
+
+ (assert (string=? ":foo"
+ (with-output-to-string (lambda () (display kw)))))
+ (assert (string=? "#:|foo bar|"
+ (with-output-to-string (lambda () (write kw)))))
+
+ ;; Regardless of keyword style, symbols must be quoted to avoid
+ ;; issues when reading it back with a different keyword style.
+ (assert (string=? "|:foo|"
+ (with-output-to-string (lambda () (write sym1)))))
+ (assert (string=? "|foo:|"
+ (with-output-to-string (lambda () (write sym2))))))))
(assert (eq? '|#:| (string->symbol "#:")))
(assert-fail (with-input-from-string "#:" read)) ; empty keyword
Trap