master: ir1-optimize-combination: stop if the node is deleted in derive-type

The branch "master" has been updated in SBCL:
       via  5122895aee971a2beaf8f5bcb9d5892e677d69a5 (commit)
      from  e1df5f074fce46cf93e87d2236fe547dfb7f438d (commit)

- Log -----------------------------------------------------------------
commit 5122895aee971a2beaf8f5bcb9d5892e677d69a5
Author: Stas Boukarev <[email protected]>
Date:   Tue Apr 7 03:03:33 2026 +0300

    ir1-optimize-combination: stop if the node is deleted in derive-type
    
    Fixes lp#2147385
---
 src/compiler/array-tran.lisp | 19 +++++++++++--------
 src/compiler/ir1opt.lisp     |  5 ++++-
 tests/compiler-2.pure.lisp   |  7 +++++++
 3 files changed, 22 insertions(+), 9 deletions(-)

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index f8061aca2..a3a1914e8 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -139,14 +139,17 @@
 ;;; return type is going to be the same as the new-value for SETF
 ;;; functions.
 (defun assert-new-value-type (new-value array)
-  (let ((type (type-array-element-type (lvar-type array))))
-    (unless (eq type *wild-type*)
-      (assert-lvar-type
-       new-value
-       type
-       (lexenv-policy (node-lexenv (lvar-dest new-value)))
-       'aref-context)))
-  (lvar-type new-value))
+  (let ((type (type-array-element-type (lvar-type array)))
+        (value-type (lvar-type new-value)))
+    (cond ((eq type *wild-type*)
+           value-type)
+          (t
+           (assert-lvar-type
+            new-value
+            type
+            (lexenv-policy (node-lexenv (lvar-dest new-value)))
+            'aref-context)
+           (type-intersection value-type type)))))
 
 (defoptimizers externally-checkable-type
     (hairy-data-vector-set/check-bounds
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 93896c2a0..42b44116c 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1216,7 +1216,10 @@
              (let ((type (derive-combination-type node show)))
                (when type
                  (derive-node-type node type)
-                 (maybe-terminate-block node nil)))))
+                 (when (eq (node-derived-type node) *empty-type*)
+                   (if (node-deleted node)
+                       (return-from ir1-optimize-combination))
+                   (maybe-terminate-block node nil))))))
       (ecase kind
         (:local
          (let ((fun (combination-lambda node)))
diff --git a/tests/compiler-2.pure.lisp b/tests/compiler-2.pure.lisp
index 08dbcf2c3..7351f01e9 100644
--- a/tests/compiler-2.pure.lisp
+++ b/tests/compiler-2.pure.lisp
@@ -5136,3 +5136,10 @@
    (sb-int:named-lambda ftype-key-default-type (&key (a 1))
      a)
    integer))
+
+(with-test (:name :deleted-node-in-derive-type)
+  (checked-compile
+   `(lambda (a)
+      (declare ((simple-array nil (9)) a))
+      (setf (aref a 0) 1)
+      a)))

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


hooks/post-receive
-- 
SBCL