From 7df3c11a37f85e474e35af14fb40d9fa62843c79 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Mon, 5 Dec 2011 15:47:13 +0400 Subject: [PATCH] Fix my previous commit on setf expansions. Fix the case when `default' in (setf (getf x y default) z) isn't provided. Add tests. --- src/code/early-setf.lisp | 4 ++-- tests/setf.impure.lisp | 7 +++++++ 2 files changed, 9 insertions(+), 2 deletions(-) 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 -- 1.7.10.4