From 28a8834292e1f3e708fffec11f5190d419b14850 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Mon, 26 Nov 2018 03:01:09 +0000 Subject: [PATCH] Escape only the character that needs it. --- src/runtime/printer.scm | 12 ++++++++---- tests/runtime/test-readwrite.scm | 2 +- 2 files changed, 9 insertions(+), 5 deletions(-) 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?) -- 2.25.1