X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-setf.lisp;h=1d41c5c40b3de80c30912ceef69396caadfccabc;hb=bfe145acc01eb7a43790173db4f08610ae9cb07a;hp=5dbc2161e5572b4ff7d4ee10920fa47d38d74946;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/late-setf.lisp b/src/code/late-setf.lisp
index 5dbc216..1d41c5c 100644
--- 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