Escape only the character that needs it.

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index 97090ee7f082aa91d9d5c179be76dd2431bae8fa..aead849a838a5afd1353478303e794514a9de84a 100644 (file)
--- a/src/runtime/printer.scm
+++ b/src/runtime/printer.scm
@@ -552,7 +552,7 @@ USA.
       (begin
         (*print-char #\| context)
        (string-for-each (lambda (char)
-                          (print-string-char char context))
+                          (print-string-char char context #\|))
                         s)
         (*print-char #\| context))))
 
@@ -590,13 +590,13 @@ USA.
           (*print-char #\" context)
          (do ((index 0 (fix:+ index 1)))
              ((not (fix:< index end*)))
-           (print-string-char (string-ref string index) context))
+           (print-string-char (string-ref string index) context #\"))
           (if (< end* end)
               (*print-string "..." context))
           (*print-char #\" context))
       (*print-string string context)))
 
-(define (print-string-char char context)
+(define (print-string-char char context quote-char)
   (case char
     ((#\bel)
      (*print-char #\\ context)
@@ -613,8 +613,12 @@ USA.
     ((#\tab)
      (*print-char #\\ context)
      (*print-char #\t context))
-    ((#\\ #\" #\|)
+    ((#\\)
      (*print-char #\\ context)
+     (*print-char #\\ context))
+    ((#\" #\|)
+     (if (eqv? char quote-char)
+         (*print-char #\\ context))
      (*print-char char context))
     (else
      (if (and (char-in-set? char char-set:normal-printing)

diff --git a/tests/runtime/test-readwrite.scm b/tests/runtime/test-readwrite.scm
index 5f60245a26c5b108e043105597b8e3e4d4c25118..09918bb9a9b6c07a4eb494013446715736a382f9 100644 (file)
--- a/tests/runtime/test-readwrite.scm
+++ b/tests/runtime/test-readwrite.scm
@@ -116,7 +116,7 @@ USA.
     ("-inf.0-inf.0i" ,assert-complex-nonreal)
     ("+inf.0+nan.0i" ,assert-complex-nonreal)
     ("+nan.0+inf.0i" ,assert-complex-nonreal)
-    ("\"|\"" ,assert-string xfail)
+    ("\"|\"" ,assert-string)
     ("\"\\\"\"" ,assert-string)
     ("\"\\\\\"" ,assert-string))
   (lambda (string #!optional assertion xfail?)