From: Stas Boukarev <stassats@gmail.com>
Date: Mon, 5 Dec 2011 11:47:13 +0000 (+0400)
Subject: Fix my previous commit on setf expansions.
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=7df3c11a37f85e474e35af14fb40d9fa62843c79;p=sbcl.git

Fix my previous commit on setf expansions.

Fix the case when `default' in (setf (getf x y default) z) isn't provided.

Add tests.
---

diff --git a/src/code/early-setf.lisp b/src/code/early-setf.lisp
index fdcac0c..3cddab4 100644
--- a/src/code/early-setf.lisp
+++ b/src/code/early-setf.lisp
@@ -475,7 +475,7 @@
 (sb!xc:define-setf-expander get (symbol prop &optional default)
   (let ((symbol-temp (gensym))
         (prop-temp (gensym))
-        (def-temp (gensym))
+        (def-temp (if default (gensym)))
         (newval (gensym)))
     (values `(,symbol-temp ,prop-temp ,@(if default `(,def-temp)))
             `(,symbol ,prop ,@(if default `(,default)))
@@ -487,7 +487,7 @@
 (sb!xc:define-setf-expander gethash (key hashtable &optional default)
   (let ((key-temp (gensym))
         (hashtable-temp (gensym))
-        (default-temp (gensym))
+        (default-temp (if default (gensym)))
         (new-value-temp (gensym)))
     (values
      `(,key-temp ,hashtable-temp ,@(if default `(,default-temp)))
diff --git a/tests/setf.impure.lisp b/tests/setf.impure.lisp
index b34349a..b6b7d2f 100644
--- a/tests/setf.impure.lisp
+++ b/tests/setf.impure.lisp
@@ -107,4 +107,11 @@
               (error ()
                 :error)))))
 
+(with-test (:name :getf-unused-default-variable)
+  (handler-bind ((style-warning #'error))
+    (compile nil `(lambda (x y)
+                    (setf (gethash :x x 0) 4)
+                    (setf (getf y :y 0) 4)
+                    (setf (get 'z :z 0) 4)))))
+
 ;;; success