0.8.21.6:

[sbcl.git] / src / code / late-setf.lisp

diff --git a/src/code/late-setf.lisp b/src/code/late-setf.lisp
index 5dbc216..1d41c5c 100644 (file)
--- a/src/code/late-setf.lisp
+++ b/src/code/late-setf.lisp
@@ -17,9 +17,6 @@
 
 (in-package "SB!IMPL")
 
-(file-comment
-  "$Header$")
-
 (defmacro-mundanely psetf (&rest args &environment env)
   #!+sb-doc
   "This is to SETF as PSETQ is to SETQ. Args are alternating place
@@ -88,9 +85,12 @@
       (dolist (place places)
        (multiple-value-bind (dummies vals newval setter getter)
            (sb!xc:get-setf-expansion place env)
-         (setq all-dummies (append all-dummies dummies)
-               all-vals (append all-vals vals)
-               newvals (append newvals newval))
+         ;; ANSI 5.1.2.3 explains this logic quite precisely.  --
+         ;; CSR, 2004-06-29
+         (setq all-dummies (append all-dummies dummies (cdr newval))
+               all-vals (append all-vals vals
+                                (mapcar (constantly nil) (cdr newval)))
+               newvals (append newvals (list (car newval))))
          (setters setter)
          (getters getter)))
       (values all-dummies all-vals newvals