master: Make DEFSETF warn a bit more like DEFMACRO

The branch "master" has been updated in SBCL:
       via  56b8cb391b9956532d675f94720e48081f4285d9 (commit)
      from  bfd25952d5caa8984811f60dba50420213cf502d (commit)

- Log -----------------------------------------------------------------
commit 56b8cb391b9956532d675f94720e48081f4285d9
Author: Gabor Melis <[email protected]>
Date:   Wed Apr 8 11:15:31 2026 +0200

    Make DEFSETF warn a bit more like DEFMACRO
    
    When (SETF FOO) was assumed to be a function, (DEFSETF FOO ...) used
    to signal a full warning, and repeated (DEFSETF FOO ...) signalled the
    same warning again.
    
    To bring the behavior closer to that of DEFMACRO, DEFSETF now only
    signals a STYLE-WARNING and only the first time around.
---
 src/code/setf.lisp   |  8 ++++++--
 tests/setf.pure.lisp | 17 +++++++++++------
 2 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/src/code/setf.lisp b/src/code/setf.lisp
index a02673912..cf771fef1 100644
--- a/src/code/setf.lisp
+++ b/src/code/setf.lisp
@@ -443,8 +443,12 @@
          ;; default can be :assumed, PRESENT-P disambiguates "defaulted" from
          ;; "known" to have made an existence assumption.
          (when present-p
-           (warn "defining setf macro for ~S when ~S was previously ~
-             treated as a function" name setf-fn-name)))
+           ;; This mimics the behavior of %DEFMACRO.
+           (style-warn "~S is being redefined as a setf macro ~
+                       when it was previously assumed to be a function."
+                       name)
+           (undefine-fun-name setf-fn-name)
+           (clear-info :function :where-from setf-fn-name)))
         ;; This is a useless and unavoidable warning during self-build.
         ;; cf. similar disabling of warning in WARN-IF-SETF-MACRO.
         #-sb-xc-host
diff --git a/tests/setf.pure.lisp b/tests/setf.pure.lisp
index d4c7efda5..f2b502676 100644
--- a/tests/setf.pure.lisp
+++ b/tests/setf.pure.lisp
@@ -119,14 +119,19 @@
                     (setf (getf y :y 0) 4)
                     (setf (get 'z :z 0) 4)))))
 
-(with-test (:name :setf-fun-and-macro-full-warn)
+(with-test (:name :setf-fun-and-macro-style-warn)
   ;; make the compiler assume existence of #'(setf shoe-color)
   (handler-bind ((warning #'muffle-warning))
-      (compile nil '(lambda (x) (setf (shoe-color x) 'cordovan))))
-  ;; now we get a full warning because the macro was seen too late.
-  (assert (typep (handler-case (eval '(defsetf shoe-color set-shoe-color))
-                   (warning (c) c))
-                 '(and warning (not style-warning)))))
+    (compile nil '(lambda (x) (setf (shoe-color x) 'cordovan))))
+  (let ((warning nil))
+    ;; We get a STYLE-WARNING because the macro was seen too late ...
+    (handler-bind ((warning (lambda (w) (setq warning w))))
+      (eval '(defsetf shoe-color set-shoe-color)))
+    (assert (typep warning 'style-warning))
+    ;; but only the first time around.
+    (assert (eq (handler-case (eval '(defsetf shoe-color set-shoe-color))
+                  (warning (c) c))
+                'shoe-color))))
 
 (with-test (:name :setf-fun-and-macro-style-1)
   (eval '(defun (setf shoe-size) (new x) x new))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL