X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=tests%2Fsetf.impure.lisp;h=0b8a86723d77ae0cbb02aec4431288907e59672a;hb=f73aadf04d841e0f1bfede4c11a13c4ba5c4e264;hp=b15917360f9042f151268735288b06e0d2cae296;hpb=175c318c892b0627b36fa3c4db66f59680242204;p=sbcl.git

diff --git a/tests/setf.impure.lisp b/tests/setf.impure.lisp
index b159173..0b8a867 100644
--- a/tests/setf.impure.lisp
+++ b/tests/setf.impure.lisp
@@ -51,4 +51,43 @@
   (setf (macro-function 'nothing-at-all nil) fun)
   (assert (eq fun (macro-function 'nothing-at-all nil))))
 
+
+;;; DEFSETF accepts &ENVIRONMENT but not &AUX
+(defsetf test-defsetf-env-1  (&environment env) (new)
+  (declare (ignore new))
+  (if (macro-function 'defsetf-env-trick env)
+      :local
+      :global))
+
+(defsetf test-defsetf-env-2  (local global &environment env) (new)
+  (declare (ignore new))
+  (if (macro-function 'defsetf-env-trick env)
+      local
+      global))
+
+(assert (eq :local (macrolet ((defsetf-env-trick ()))
+                     (setf (test-defsetf-env-1) 13))))
+
+(assert (eq :global (setf (test-defsetf-env-1) 13)))
+
+(assert (eq :local (macrolet ((defsetf-env-trick ()))
+                     (setf (test-defsetf-env-2 :local :oops) 13))))
+
+(assert (eq :global (setf (test-defsetf-env-2 :oops :global) 13)))
+
+(assert (eq :error
+            (handler-case
+                (eval '(defsetf test-defsetf-aux (&aux aux) (new) nil))
+              (error ()
+                :error))))
+
+(handler-bind ((style-warning #'error))
+  (compile nil '(lambda ()
+                 (defsetf test-defsetf-no-env (foo) (new)
+                   `(set-foo ,foo ,new))))
+  (compile nil '(lambda ()
+                 (defsetf test-defsetf-ignore-env (foo &environment env) (new)
+                   (declare (ignore env))
+                   `(set-foo ,foo ,new)))))
+
 ;;; success