Improve handling of read macros in `pretty-print'.

* module/ice-9/pretty-print.scm (generic-write)[wr]: Handle read macros
  that appear in the middle of a list.

* test-suite/tests/print.test (prints?): New macro.
  ("pretty-print"): New test prefix.

module/ice-9/pretty-print.scm

@@ -17,6 +17,8 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 ;;;; 
 (define-module (ice-9 pretty-print)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (pretty-print
             truncated-print))
 
@@ -54,12 +56,21 @@
     (and col (output str) (+ col (string-length str))))
 
   (define (wr obj col)
-    (cond ((and (pair? obj)
-		(read-macro? obj))
-	   (wr (read-macro-body obj)
-	       (out (read-macro-prefix obj) col)))
-	  (else
-	   (out (object->string obj (if display? display write)) col))))
+    (let loop ((obj obj)
+               (col col))
+      (match obj
+        (((or 'quote 'quasiquote 'unquote 'unquote-splicing) body)
+         (wr body (out (read-macro-prefix obj) col)))
+        ((head . (rest ...))
+         ;; A proper list: do our own list printing so as to catch read
+         ;; macros that appear in the middle of the list.
+         (let ((col (loop head (out "(" col))))
+           (out ")"
+                (fold (lambda (i col)
+                        (loop i (out " " col)))
+                      col rest))))
+        (_
+         (out (object->string obj (if display? display write)) col)))))
 
   (define (pp obj col)
 

test-suite/tests/print.test

@@ -20,6 +20,41 @@
   #:use-module (ice-9 pretty-print)
   #:use-module (test-suite lib))
 
+(define-syntax prints?
+  ;; #t if EXP prints as RESULT.
+  (syntax-rules ()
+    ((_ exp result)
+     (string=? result
+               (with-output-to-string
+                 (lambda ()
+                   (pretty-print 'exp)))))))
+
+
+(with-test-prefix "pretty-print"
+
+  (pass-if "pair"
+    (prints? (a . b) "(a . b)\n"))
+
+  (pass-if "list"
+    (prints? (a b c) "(a b c)\n"))
+
+  (pass-if "dotted list"
+    (prints? (a b . c) "(a b . c)\n"))
+
+  (pass-if "quote"
+    (prints? 'foo "'foo\n"))
+
+  (pass-if "non-starting quote"
+    (prints? (foo 'bar) "(foo 'bar)\n"))
+
+  (pass-if "nested quote"
+    (prints? (''foo) "(''foo)\n"))
+
+  (pass-if "quasiquote & co."
+    (prints?  (define foo `(bar ,(+ 2 3)))
+             "(define foo `(bar ,(+ 2 3)))\n")))
+
+
 (with-test-prefix "truncated-print"
   (define exp '(a b #(c d e) f . g))