From 7348bfc27e4e8e265ee8b0c4863eeabd92ea0b2a Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Tue, 29 Jun 2004 20:44:40 +0000
Subject: [PATCH] Extra values were not correctly handled by the values setf
 expander. This causes

  (let ((a t) (b t) (c t) (d t) (e t) (f t))
    (setf (values a (values b c) (values d) (values e f)) (values 0 1 2 3 4 5 6))
    (list a b c d e f))

to return the (0 1 2 3 4 5) instead of (0 1 nil 2 3 nil).
---
 code/macros.lisp | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/code/macros.lisp b/code/macros.lisp
index a6634a43e..30efb7e6b 100644
--- a/code/macros.lisp
+++ b/code/macros.lisp
@@ -5,7 +5,7 @@
 ;;; Carnegie Mellon University, and has been placed in the public domain.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.100 2004/05/18 13:43:08 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/macros.lisp,v 1.101 2004/06/29 20:44:40 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1257,9 +1257,12 @@
       (dolist (place places)
 	(multiple-value-bind (dummies vals newval setter getter)
 	    (get-setf-expansion place env)
-	  (setf all-dummies (append all-dummies dummies))
-	  (setf all-vals (append all-vals vals))
-	  (setf newvals (append newvals newval))
+	  ;; ANSI CL 5.1.2.3 explains that extra places are set to
+	  ;; nil.
+	  (setf all-dummies (append all-dummies dummies (cdr newval)))
+	  (setf all-vals (append all-vals vals
+				 (mapcar (constantly nil) (cdr newval))))
+	  (setf newvals (append newvals (list (car newval))))
 	  (setters setter)
 	  (getters getter)))
       (values all-dummies all-vals newvals
-- 
GitLab