From: Taylor R Campbell <campbell@mumble.net>
Date: Mon, 26 Nov 2018 03:01:09 +0000 (+0000)
Subject: Escape only the character that needs it.
X-Git-Tag: mit-scheme-pucked-10.1.7~3^2~173
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=28a8834292e1f3e708fffec11f5190d419b14850;p=mit-scheme.git

Escape only the character that needs it.
---

diff --git a/src/runtime/printer.scm b/src/runtime/printer.scm
index 97090ee7f..aead849a8 100644
--- 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 5f60245a2..09918bb9a 100644
--- 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?)