master: Allow (setf (slot-value x 'read-only-struct-slot)) at compile-time

The branch "master" has been updated in SBCL:
       via  a60b90261b5078692fcac2a698f477211275a0df (commit)
      from  e4e628ab84b1832297cedeb2d2613509cb6a601d (commit)

- Log -----------------------------------------------------------------
commit a60b90261b5078692fcac2a698f477211275a0df
Author: Stas Boukarev <[email protected]>
Date:   Mon Aug 24 01:40:56 2026 +0300

    Allow (setf (slot-value x 'read-only-struct-slot)) at compile-time
    
    Don't transform it to (setf struct-read-only-struct-slot).
    It works when x or read-only-struct-slot are not known at compile
    time, no reason to stop it.
---
 src/pcl/compiler-support.lisp |  6 ++++--
 tests/defstruct.impure.lisp   | 10 ++++++++++
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp
index 5d0accf31..83fa5cc43 100644
--- a/src/pcl/compiler-support.lisp
+++ b/src/pcl/compiler-support.lisp
@@ -175,8 +175,10 @@
   (deftransform sb-pcl::set-slot-value ((object slot-name new-value)
                                         (t (constant-arg symbol) t)
                                         * :node node)
-    (acond ((always-bound-struct-accessor-p object slot-name)
-            ;; Note that the SETF is undefined for :READ-ONLY slots.
+    (acond ((let ((dsd (always-bound-struct-accessor-p object slot-name)))
+              (and dsd
+                   (not (dsd-read-only dsd))
+                   dsd))
             `(setf (,(dsd-accessor-name it) object) new-value))
            ((policy node (= safety 3))
             ;; Safe code wants to check the type, and the global
diff --git a/tests/defstruct.impure.lisp b/tests/defstruct.impure.lisp
index 9097bcb08..fcbe236ed 100644
--- a/tests/defstruct.impure.lisp
+++ b/tests/defstruct.impure.lisp
@@ -1495,3 +1495,13 @@ redefinition."
     (setf (oolbc-x struct) 2)
     (assert (eql (oolbc-x struct) 2))
     (assert (eql (oolbc-z struct) 104))))
+
+(defstruct read-only-slot-value
+  (slot 0 :read-only t))
+
+(with-test (:name :read-only-slot-value)
+  (let ((i (make-read-only-slot-value)))
+    (setf (slot-value i 'slot) 6)
+    (assert (= (slot-value i 'slot)
+               (read-only-slot-value-slot i)
+               6))))

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


hooks/post-receive
-- 
SBCL