Hi all,

We've seen quite a bit of breakage with the CR patch.  Most of it has
been fixed by aeec82d, but it also uncovered another bug that has been
there since the beginning.  Eggs using srfi-128 fail, see for example:
https://salmonella-freebsd-x86-64.call-cc.org/master/clang/freebsd/x86-64/2019/05/26/salmonella-report/install/srfi-113.html

This is because srfi-128 contains identifiers like :type-test:.  Now
that keywords can no longer be assigned to, I had to submit a pull
request to this egg to add "-keyword-style none" to the compilation
options, but apparently that causes the types file to be emitted without
pipe quotes around :type-tests: and other identifiers, so they will be
read as keywords unless the other egg also happens to use
"-keyword-style none".

The attached patch ensures we write such identifiers as |:type-tests:|
regardless of keyword style.  This way, it can also be read by any
program, even if it uses a different keyword style than the writer.

Cheers,
Peter
From 927f4a66c2c28ad59e56b7e7083370a2d3fc53f8 Mon Sep 17 00:00:00 2001
From: Peter Bex <[email protected]>
Date: Sun, 26 May 2019 13:45:44 +0200
Subject: [PATCH] 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.
---
 NEWS                    |  5 +++
 library.scm             |  5 ++-
 tests/library-tests.scm | 84 ++++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 86 insertions(+), 8 deletions(-)

diff --git a/NEWS b/NEWS
index ee173e0c..3ebed6c0 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
-- 
2.11.0

Attachment: signature.asc
Description: PGP signature

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to