~ chicken-core (chicken-5) fb5294a960e74dc3b040aa5e9938438c4216dcc2

commit fb5294a960e74dc3b040aa5e9938438c4216dcc2
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Thu Apr 7 08:53:28 2011 -0400
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Apr 7 08:53:28 2011 -0400

    pretty-printer fix, contributed by mario

diff --git a/distribution/manifest b/distribution/manifest
index 3e9c9270..b2a076d2 100644
--- a/distribution/manifest
+++ b/distribution/manifest
@@ -172,6 +172,7 @@ tests/dwindtst.scm
 tests/dwindtst.expected
 tests/callback-tests.scm
 tests/reader-tests.scm
+tests/pp-tests.scm
 tweaks.scm
 utils.scm
 apply-hack.x86.S
diff --git a/extras.scm b/extras.scm
index a2b0d7c5..7b0142dc 100644
--- a/extras.scm
+++ b/extras.scm
@@ -337,19 +337,24 @@
 				    (let loop ((i 0) (j 0) (col (out "\"" col)))
 				      (if (and col (fx< j (string-length obj)))
 					  (let ((c (string-ref obj j)))
-					    (cond ((assq c '((#\\ . "\\")
-							     (#\" . "\\\"")
-							     (#\tab . "\\t")
-							     (#\newline . "\\n")
-							     (#\return . "\\r")))
-						   =>
-						   (lambda (a)
-						     (let ((col2 
-							    (out (##sys#substring obj i j) col)))
-						       (loop (fx+ j 1)
-							     (fx+ j 1)
-							     (out (cdr a) col2)))))
-						  (else (loop i (fx+ j 1) col))))
+                                            (if (or (char=? c #\\)
+                                                    (char=? c #\"))
+                                                (loop j
+                                                      (+ j 1)
+                                                      (out "\\"
+                                                           (out (##sys#substring obj i j)
+                                                                col)))
+                                                (cond ((assq c '((#\tab . "\\t")
+                                                                 (#\newline . "\\n")
+                                                                 (#\return . "\\r")))
+                                                       =>
+                                                       (lambda (a)
+                                                         (let ((col2
+                                                                (out (##sys#substring obj i j) col)))
+                                                           (loop (fx+ j 1)
+                                                                 (fx+ j 1)
+                                                                 (out (cdr a) col2)))))
+                                                      (else (loop i (fx+ j 1) col)))))
 					  (out "\""
 					       (out (##sys#substring obj i j) col))))))
 	    ((char? obj)        (if display?
diff --git a/tests/runtests.sh b/tests/runtests.sh
index ff19bc88..fe2435e4 100644
--- a/tests/runtests.sh
+++ b/tests/runtests.sh
@@ -113,6 +113,9 @@ $compile lolevel-tests.scm
 echo "======================================== arithmetic tests ..."
 $interpret -D check -s arithmetic-test.scm
 
+echo "======================================== pretty-printer tests ..."
+$interpret -s pp-test.scm
+
 echo "======================================== syntax tests ..."
 $interpret -s syntax-tests.scm