From a1725ee23ba55d40510600f952e5be04a261c65f Mon Sep 17 00:00:00 2001
From: Stas Boukarev <stassats@gmail.com>
Date: Tue, 12 Nov 2024 09:02:52 +0300
Subject: [PATCH] sb-walker: shadow symbol-macrolet with SPECIAL.

Like the compiler does.

Fixes lp#1053198
---
 src/pcl/walk.lisp      | 48 +++++++++++++++++++++++++-----------------
 tests/walk.impure.lisp | 10 +++++++++
 2 files changed, 39 insertions(+), 19 deletions(-)

diff --git a/src/pcl/walk.lisp b/src/pcl/walk.lisp
index a7fccf88f..5bce79d5a 100644
--- a/src/pcl/walk.lisp
+++ b/src/pcl/walk.lisp
@@ -800,25 +800,35 @@ instead of
            (let ((type (car declaration))
                  (name (cadr declaration))
                  (args (cddr declaration)))
-             (if (walked-var-declaration-p type)
-                 (note-declaration `(,type
-                                     ,(or (var-lexical-p name env) name)
-                                     ,.args)
-                                   env)
-                 (let ((canonical (sb-c::canonized-decl-spec declaration)))
-                   (typecase canonical
-                     ((cons (eql type) cons)
-                      (destructuring-bind (type &rest vars) (cdr canonical)
-                        (loop for name in vars
-                              for symbol-macro = (and (symbolp name)
-                                                      (car (variable-symbol-macro-p name env)))
-                              do (if symbol-macro
-                                     (push (list* name 'sb-sys:macro
-                                                  `(the ,type ,(cddr symbol-macro)))
-                                           (cadddr (env-lock env)))
-                                     (note-declaration canonical env)))))
-                     (t
-                      (note-declaration canonical env)))))
+             (cond ((eq type 'special)
+                    (loop for name in (cdr declaration)
+                          for var = (or (var-lexical-p name env)
+                                        name)
+                          do
+                          (note-declaration `(special ,(or var name)) env)
+                          ;; Shadow
+                          (when (variable-symbol-macro-p name env)
+                            (note-var-binding name env))))
+                   ((walked-var-declaration-p type)
+                    (note-declaration `(,type
+                                        ,(or (var-lexical-p name env) name)
+                                        ,.args)
+                                      env))
+                   (t
+                    (let ((canonical (sb-c::canonized-decl-spec declaration)))
+                      (typecase canonical
+                        ((cons (eql type) cons)
+                         (destructuring-bind (type &rest vars) (cdr canonical)
+                           (loop for name in vars
+                                 for symbol-macro = (and (symbolp name)
+                                                         (car (variable-symbol-macro-p name env)))
+                                 do (if symbol-macro
+                                        (push (list* name 'sb-sys:macro
+                                                     `(the ,type ,(cddr symbol-macro)))
+                                              (cadddr (env-lock env)))
+                                        (note-declaration canonical env)))))
+                        (t
+                         (note-declaration canonical env))))))
              (push declaration declarations)))
          (recons body
                  form
diff --git a/tests/walk.impure.lisp b/tests/walk.impure.lisp
index 1bd23cc9c..727648396 100644
--- a/tests/walk.impure.lisp
+++ b/tests/walk.impure.lisp
@@ -1063,3 +1063,13 @@ Form: C   Context: EVAL; lexically bound
           (declare (fixnum x))
           (incf x 1))))
    :allow-notes nil))
+
+(defmethod symbol-macrolet-special (s)
+  (declare (special s))
+  (symbol-macrolet ((s (slot-value x 'x)))
+    (let ()
+      (declare (special s))
+      s)))
+
+(test-util:with-test (:name :symbol-macrolet-declarations)
+  (assert (eql (symbol-macrolet-special 10) 10)))