Bugfix.

felideon · Jul 10, 2009 · ff59f87 · ff59f87
1 parent e9b8999
commit ff59f87
Show file tree

Hide file tree

Showing 3 changed files with 13 additions and 9 deletions.
diff --git a/README b/README
@@ -1,7 +1,7 @@
 CL-ALREF Utility by Adlai
 
   Many thanks to stassats on #lisp, Pascal J. Bourguignon, and also a
-  bit of inspiration from Arc's ALREF.  Updated on Sun, Jul 5th, 2009.
+  bit of inspiration from Arc's ALREF.  Updated on Fri, Jul 10th, 2009.
 
 Documentation:
 
@@ -32,7 +32,7 @@ Documentation:
 
 Changelog:
 
-  This is version 2.4.
+  This is version 2.5.
 
   Version 1.0 used (defun (setf alref) ...), which led to a bug when
     ALIST was NIL.
@@ -58,7 +58,10 @@ Changelog:
     came from blurring the line between macro-expansion time and
     evaluation time.
 
-  Version 2.4 completes that bugfix, and is thus a separate version.
+  Version 2.4 completed that bugfix.
+
+  Version 2.5 fixes a bug which would occur when the place 'alist
+    had to be setf-expanded itself. ALREF now plays nicely here too.
 
 Feel free to copy this code and use it in your projects, but please
   give credit where it's due. Also, please leave this README in place.

diff --git a/alref.asd b/alref.asd
@@ -6,7 +6,7 @@
 
 (defsystem alref
   :name "ALREF Utility"
-  :version "2.4"
+  :version "2.5"
   :maintainer "Adlai"
   :author "Adlai"
   :license "MIT-style; See README"

diff --git a/alref.lisp b/alref.lisp
@@ -23,13 +23,14 @@
                                   (key  '*default-alref-key* unsafe)
                              &environment env)
   "Set the value corresponding to ITEM in ALIST."
-  (multiple-value-bind (foo bar stores setter)
+  (multiple-value-bind (orig-temps orig-vals stores setter)
       (get-setf-expansion alist env)
-    (declare (ignore foo bar))
     (with-gensyms (it g-item g-alist g-test g-key new)
-      (values (list g-item g-alist g-test g-key it)
-              (list item alist test key
-                    `(assoc ,item ,alist :test ,test :key ,key))
+      (values (append (list g-item g-alist g-test g-key it)
+                      orig-temps)
+              (append (list item alist test key
+                            `(assoc ,item ,alist :test ,test :key ,key))
+                      orig-vals)
               `(,new)
               `(cond ((eq ,new NIL)
                       (let ((,(car stores)