From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Mon, 29 Nov 2004 13:34:02 +0000 (+0000)
Subject: 0.8.17.3:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7d33841eaefb309885a4f5fe23f6d6870f66d242;p=sbcl.git

0.8.17.3:
	Fix bug reported and patched by Kalle Olavi Niemitalo (sbcl-devel
	2004-11-12)
	... (SETF (THE (VALUES ...) (VALUES ...)) (VALUES ...)) should
		work.
	... also delete a bug fixed last month.
---

diff --git a/BUGS b/BUGS
index 6252eed..729da42 100644
--- a/BUGS
+++ b/BUGS
@@ -1496,13 +1496,6 @@ WORKAROUND:
   (it is likely that the fault lies in PPRINT-LOGICAL-BLOCK, as
   suggested by the suggested implementation of PPRINT-TABULAR)
 
-342: PPRINT-TABULAR / PPRINT-LOGICAL-BLOCK logical block start position
-  The logical block introduced by PPRINT-LOGICAL-BLOCK should not
-  include the prefix, so that
-    (pprint-tabular *standard-output* '(1 2 3) t nil 2)
-  should print
-  "(1 2 3)" rather than "(1  2 3)".
-
 343: MOP:COMPUTE-DISCRIMINATING-FUNCTION overriding causes error
   Even the simplest possible overriding of
   COMPUTE-DISCRIMINATING-FUNCTION, suggested in the PCL implementation
diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp
index 4a9aecb..5727b61 100644
--- a/src/code/early-setf.lisp
+++ b/src/code/early-setf.lisp
@@ -428,11 +428,11 @@ GET-SETF-EXPANSION directly."
 ;;; DEFINE-SETF-EXPANDER is a lot like DEFMACRO.
 (def!macro sb!xc:define-setf-expander (access-fn lambda-list &body body)
   #!+sb-doc
-  "Syntax like DEFMACRO, but creates a Setf-Method generator. The body
-  must be a form that returns the five magical values."
+  "Syntax like DEFMACRO, but creates a setf expander function. The body
+  of the definition must be a form that returns five appropriate values."
   (unless (symbolp access-fn)
-    (error "DEFINE-SETF-EXPANDER access-function name ~S is not a symbol."
-	   access-fn))
+    (error "~S access-function name ~S is not a symbol."
+           'sb!xc:define-setf-expander access-fn))
   (with-unique-names (whole environment)
     (multiple-value-bind (body local-decs doc)
 	(parse-defmacro lambda-list whole body access-fn
@@ -576,10 +576,10 @@ GET-SETF-EXPANSION directly."
 
 (sb!xc:define-setf-expander the (type place &environment env)
   (declare (type sb!c::lexenv env))
-  (multiple-value-bind (dummies vals newval setter getter)
-      (get-setf-method place env)
-    (values dummies
-	      vals
-	      newval
-	      (subst `(the ,type ,(car newval)) (car newval) setter)
-	      `(the ,type ,getter))))
+  (multiple-value-bind (temps subforms store-vars setter getter)
+      (sb!xc:get-setf-expansion place env)
+    (values temps subforms store-vars
+            `(multiple-value-bind ,store-vars
+                 (the ,type (values ,@store-vars))
+               ,setter)
+            `(the ,type ,getter))))
diff --git a/tests/setf.impure.lisp b/tests/setf.impure.lisp
index a7d29a0..c9e73f2 100644
--- a/tests/setf.impure.lisp
+++ b/tests/setf.impure.lisp
@@ -39,5 +39,12 @@
     (assert (null b))
     (assert (null d))))
 
+;;; SETF of THE with VALUES.
+(let (x y)
+  (setf (the (values fixnum fixnum) (values x y))
+        (values 1 2))
+  (assert (= x 1))
+  (assert (= y 2)))
+
 ;;; success
 (quit :unix-status 104)
diff --git a/version.lisp-expr b/version.lisp-expr
index ca486d5..7a1910a 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.17.2"
+"0.8.17.3"