PPRINT (setf . a) correctly.

It was printed as (setf a).

Reported by Douglas Katzman.

diff --git a/NEWS b/NEWS
index 73781e0..b7268f3 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -3,6 +3,7 @@ changes relative to sbcl-1.1.11:
   * bug fix: probe-file now can access symlinks to pipes and sockets in
     /proc/pid/fd on Linux. (reported by Eric Schulte)
   * bug fix: SBCL can now be built on Solaris x86-64.
+  * bug fix: (setf . a) is pprinted correctly (reported by Douglas Katzman).
   
 changes in sbcl-1.1.11 relative to sbcl-1.1.10:
   * enhancement: support building the manual under texinfo version 5.

diff --git a/src/code/pprint.lisp b/src/code/pprint.lisp
index 1e39693..24e7d97 100644 (file)
--- a/src/code/pprint.lisp
+++ b/src/code/pprint.lisp
@@ -1218,6 +1218,8 @@ line break."
     (output-object (pprint-pop) stream)
     (pprint-exit-if-list-exhausted)
     (write-char #\space stream)
+    (unless (listp (cdr list))
+      (write-string ". " stream))
     (pprint-newline :miser stream)
     (pprint-logical-block (stream (cdr list) :prefix "" :suffix "")
       (loop

diff --git a/tests/pprint.impure.lisp b/tests/pprint.impure.lisp
index 39884e0..4f10bd0 100644 (file)
--- a/tests/pprint.impure.lisp
+++ b/tests/pprint.impure.lisp
@@ -297,5 +297,11 @@
                                    `(progn ,@(identity #1#)))
                                  :circle t :pretty t)))
     (assert (not (search "#2#" string)))))
+
+(with-test (:name :pprint-dotted-setf)
+  (let ((*print-pretty* t))
+    (equal (format nil "~a" '(setf . a))
+           "(SETF . A)")))
+
 \f
 ;;; success