~ chicken-core (chicken-5) d31f8ea988425e94745258f174a86fdb2bb06459

commit d31f8ea988425e94745258f174a86fdb2bb06459
Author:     Peter Bex <peter.bex@xs4all.nl>
AuthorDate: Fri Aug 30 16:51:17 2013 +0200
Commit:     Moritz Heidkamp <moritz@twoticketsplease.de>
CommitDate: Tue Sep 17 11:19:42 2013 +0200

    Fix handling of -no-symbol-escape and -no-parentheses-synonyms
    
    Add some basic tests for the effect of the underlying parameters on
    READ, and fix the manual which mentioned a STYLE argument for
    -no-parentheses-synonyms Thanks to Matt Gushee for reporting this bug.
    
    Signed-off-by: Moritz Heidkamp <moritz@twoticketsplease.de>

diff --git a/library.scm b/library.scm
index 5c101e32..2d563289 100644
--- a/library.scm
+++ b/library.scm
@@ -2747,9 +2747,11 @@ EOF
 			 (if (and skw (eq? ksp #:suffix))
 			     (k (##sys#reverse-list->string (cdr lst)) #t)
 			     (k (##sys#reverse-list->string lst) pkw)))
+                        ((memq c reserved-characters)
+			  (reserved-character c))
 			(else
 			 (let ((c (##sys#read-char-0 port)))
-			   (case (and sep c)
+			   (case c
 			     ((#\|) 
 			      (let ((part (r-string #\|)))
 				(loop (append (##sys#fast-reverse (##sys#string->list part)) lst)
@@ -2858,13 +2860,8 @@ EOF
 
           ; now have the state to make a decision.
           (set! reserved-characters
-	        (if psp
-	            (if sep
-	                '()
-	                '(#\[ #\] #\{ #\}) )
-	            (if sep
-	                '(#\|)
-	                '(#\[ #\] #\{ #\} #\|))))
+                (append (if (not psp) '(#\[ #\] #\{ #\}) '())
+                        (if (not sep) '(#\|) '())))
 
 	  (r-spaces)
 	  (let* ((c (##sys#peek-char-0 port))
diff --git a/manual/Using the compiler b/manual/Using the compiler
index 1bfc36c5..9807eaa6 100644
--- a/manual/Using the compiler	
+++ b/manual/Using the compiler	
@@ -102,7 +102,7 @@ the source text should be read from standard input.
 
 ; -no-module-registration : Do not generate module-registration code in the compiled code. This is only needed if you want to use an import library that is generated by other means (manually, for example).
 
-; -no-parentheses-synonyms STYLE : Disables list delimiter synonyms, [..] and {...} for (...).
+; -no-parentheses-synonyms : Disables list delimiter synonyms, [..] and {...} for (...).
 
 ; -no-procedure-checks : disable procedure call checks
 
diff --git a/manual/Using the interpreter b/manual/Using the interpreter
index 8d6d6996..cec50aa7 100644
--- a/manual/Using the interpreter	
+++ b/manual/Using the interpreter	
@@ -41,7 +41,7 @@ The options recognized by the interpreter are:
 
 ; -n  -no-init : Do not load initialization-file. If this option is not given and the file {{$HOME/.csirc}} exists, then it is loaded before the read-eval-print loop commences.
 
-;     -no-parentheses-synonyms STYLE : Disables list delimiter synonyms, [..] and {...} for (...).
+;     -no-parentheses-synonyms : Disables list delimiter synonyms, [..] and {...} for (...).
 
 ;     -no-symbol-escape : Disables support for escaped symbols, the |...| form.
 
diff --git a/tests/library-tests.scm b/tests/library-tests.scm
index 24bbc1d1..8f3f07b3 100644
--- a/tests/library-tests.scm
+++ b/tests/library-tests.scm
@@ -283,6 +283,29 @@
   (assert (string=? "aBc" (symbol->string (with-input-from-string "|aBc|" read))))
   (assert (string=? "aBc" (symbol->string (with-input-from-string "a\\Bc" read)))))
 
+(parameterize ((symbol-escape #f))
+  (assert (string=? "aBc" (symbol->string (with-input-from-string "aBc" read))))
+  (assert-fail (with-input-from-string "|aBc|" read))
+  (assert-fail (with-input-from-string "a|Bc" read)))
+(parameterize ((symbol-escape #t))
+  (assert (string=? "aBc" (symbol->string (with-input-from-string "aBc" read))))
+  (assert (string=? "aBc" (symbol->string (with-input-from-string "|aBc|" read))))
+  (assert (string=? "aB c" (symbol->string (with-input-from-string "|aB c|" read))))
+  ;; The following is an extension/generalisation of r7RS
+  (assert (string=? "aBc" (symbol->string (with-input-from-string "a|Bc|" read))))
+  ;; "Unterminated string" (unterminated identifier?)
+  (assert-fail (with-input-from-string "a|Bc" read)))
+
+;;; Paren synonyms
+
+(parameterize ((parentheses-synonyms #f))
+  (assert (eq? '() (with-input-from-string "()" read)))
+  (assert-fail (with-input-from-string "[]" read))
+  (assert-fail (with-input-from-string "{}" read)))
+(parameterize ((parentheses-synonyms #t))
+  (assert (eq? '() (with-input-from-string "()" read)))
+  (assert (eq? '() (with-input-from-string "[]" read)))
+  (assert (eq? '() (with-input-from-string "{}" read))))
 
 ;;; keywords