master: More thorough tracking of macro argument modifications

The branch "master" has been updated in SBCL:
       via  5bfa2103ecc8139ef53198d71d32f5ac67ab1925 (commit)
      from  c3389405764a66412dc4bad86d133fb520bdddd8 (commit)

- Log -----------------------------------------------------------------
commit 5bfa2103ecc8139ef53198d71d32f5ac67ab1925
Author: Stas Boukarev <[email protected]>
Date:   Sun Aug 30 04:16:57 2026 +0300

    More thorough tracking of macro argument modifications
---
 src/compiler/ir1util.lisp | 35 +++++++++++++++++------------------
 tests/bad-code.pure.lisp  |  9 +++++++++
 2 files changed, 26 insertions(+), 18 deletions(-)

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 33649646f..fdd35f985 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -3839,15 +3839,7 @@ is :ANY, the function name is not checked."
 
 (defun lvar-constants (lvar &optional walk-functions)
   (named-let recurse ((lvar lvar) (seen nil))
-    (let* ((uses (lvar-uses lvar))
-           (lvar (or (and (ref-p uses)
-                          (let ((ref (principal-lvar-ref lvar)))
-                            (and ref
-                                 (or
-                                  (lambda-var-ref-lvar ref)
-                                  (node-lvar ref)))))
-                     lvar))
-           (uses (lvar-uses lvar)))
+    (let ((uses (lvar-uses lvar)))
       (flet ((handle-ref (ref)
                (let* ((ref (principal-ref ref))
                       (leaf (and ref
@@ -3886,6 +3878,14 @@ is :ANY, the function name is not checked."
                (values :values (list (lvar-value lvar))))
               ((constant-lvar-uses-p lvar)
                (values :values (lvar-uses-values lvar)))
+              ((loop for annot in (lvar-annotations lvar)
+                     when (lvar-lambda-var-annotation-p annot)
+                     do (let ((lambda-var (lvar-lambda-var-annotation-lambda-var annot)))
+                          (when (and (lambda-var-constant lambda-var)
+                                     (not (lambda-var-sets lambda-var)))
+                            (return-from
+                             lvar-constants
+                              (values :macro lambda-var))))))
               ((ref-p uses)
                (handle-ref uses))
               (walk-functions
@@ -3921,15 +3921,6 @@ is :ANY, the function name is not checked."
         (leaf-debug-name leaf))))
 
 (defun process-lvar-modified-annotation (lvar annotation)
-  (loop for annot in (lvar-annotations lvar)
-        when (lvar-lambda-var-annotation-p annot)
-        do (let ((lambda-var (lvar-lambda-var-annotation-lambda-var annot)))
-             (when (and (lambda-var-constant lambda-var)
-                        (not (lambda-var-sets lambda-var)))
-               (warn 'sb-kernel::macro-arg-modified
-                     :fun-name (lvar-modified-annotation-caller annotation)
-                     :variable (lambda-var-original-name lambda-var))
-               (return-from process-lvar-modified-annotation))))
   (multiple-value-bind (type values) (lvar-constants lvar t)
     (labels ((modifiable-p (value)
                (or (consp value)
@@ -3944,6 +3935,14 @@ is :ANY, the function name is not checked."
                         :fun-name (lvar-modified-annotation-caller annotation)
                         :values sans-nil)))))
      (case type
+       (:macro
+        (let ((lambda-var values))
+          (when (and (lambda-var-constant lambda-var)
+                     (not (lambda-var-sets lambda-var)))
+            (warn 'sb-kernel::macro-arg-modified
+                  :fun-name (lvar-modified-annotation-caller annotation)
+                  :variable (lambda-var-original-name lambda-var))
+            (return-from process-lvar-modified-annotation))))
        (:values
         (report values)
         t)
diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp
index b75c7563c..e0c2708f4 100644
--- a/tests/bad-code.pure.lisp
+++ b/tests/bad-code.pure.lisp
@@ -1121,3 +1121,12 @@
        :allow-warnings t)
     (assert (and fail warn))
     (assert (eql (funcall fun) 2))))
+
+(with-test (:name :macro-argument-modification)
+  (assert (nth-value 2
+                     (checked-compile
+                      '(lambda ()
+                        (macrolet ((a (a)
+                                     (delete 2 (list* '- a))))
+                          (a (* 2 3))))
+                      :allow-warnings 'sb-kernel::macro-arg-modified))))

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


hooks/post-receive
-- 
SBCL