master: Stop reusing potentially optimized inlined functions

The branch "master" has been updated in SBCL:
       via  3c314be35341cc72d98e67e8b26316d6d39fe898 (commit)
      from  facbb275e36000696be58d882578008b8aed2713 (commit)

- Log -----------------------------------------------------------------
commit 3c314be35341cc72d98e67e8b26316d6d39fe898
Author: Stas Boukarev <[email protected]>
Date:   Sat Aug 15 01:49:59 2026 +0300

    Stop reusing potentially optimized inlined functions
    
    Fixes lp#2163502
---
 src/compiler/ir1opt.lisp   | 26 ++++++--------------------
 tests/compiler-2.pure.lisp |  9 +++++++++
 tests/compiler.impure.lisp |  5 ++---
 3 files changed, 17 insertions(+), 23 deletions(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 47e14a921..d24d40e1e 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1643,6 +1643,11 @@
        (with-ir1-environment-from-node call
          (let ((fun (defined-fun-functional leaf)))
            (cond ((or (not fun)
+                      ;; Type propagation might have already made
+                      ;; changes to the previously inlined function.
+                      ;; Don't try to detect whether something has
+                      ;; changed and inline again.
+                      (boundp '*component-being-compiled*)
                       ;; It has already been processed by locall,
                       ;; inline again.
                       (not (functional-kind-eq fun nil)))
@@ -2973,26 +2978,7 @@
                     ;; type to its refs yet.
                     ((lambda-var-optimistic-type var))
                     (t
-                     (propagate-to-refs var type)))))
-
-      ;; It's possible to discover new inline calls which may have
-      ;; incompatible argument types, so don't allow reuse of this
-      ;; functional during future inline expansion to prevent
-      ;; spurious type conflicts.
-      (let ((defined-fun (and (functional-inline-expanded fun)
-                              (gethash (leaf-%source-name fun)
-                                       (free-funs *ir1-namespace*)))))
-        (when (defined-fun-p defined-fun)
-          (do ((args (basic-combination-args call) (cdr args))
-               (vars vars (cdr vars)))
-              ((null args))
-            (let ((arg (car args))
-                  (var (car vars)))
-              (unless (and arg
-                           (eq (leaf-type var) *universal-type*))
-                (setf (defined-fun-functional defined-fun) nil)
-                (return))))))))
-
+                     (propagate-to-refs var type)))))))
   (values))
 
 ;;;; multiple values optimization
diff --git a/tests/compiler-2.pure.lisp b/tests/compiler-2.pure.lisp
index 1a759d410..62872761f 100644
--- a/tests/compiler-2.pure.lisp
+++ b/tests/compiler-2.pure.lisp
@@ -5146,3 +5146,12 @@
                                                                 (declare (ignore d))
                                                                 (values a b c)) -1 t (floor x y))))
                  '(sb-kernel::floor1))))
+
+(with-test (:name :reusing-inlined-function)
+  (checked-compile-and-assert
+      (:optimize '(:safety 1 :debug 3 :space 0))
+      `(lambda (b)
+         (values (elt '(1 2) b)
+                 (elt '(3 4) b)))
+    ((0) (values 1 3))
+    ((1) (values 2 4))))
diff --git a/tests/compiler.impure.lisp b/tests/compiler.impure.lisp
index 98a2be6c8..54e517411 100644
--- a/tests/compiler.impure.lisp
+++ b/tests/compiler.impure.lisp
@@ -3219,11 +3219,10 @@
   ;; NEW-INLINE-FUNCTIONAL-TYPE-CONFLICT.2, and one for INLINE-FUN.
   (assert (= 3 (length (sb-disassem::get-code-segments
                         (sb-kernel:fun-code-header #'new-inline-functional-type-conflict.2)))))
-  ;; We should have no type information from the arguments, because
-  ;; the functional is shared.
+
   (let ((type (sb-kernel:%simple-fun-type
                (symbol-function 'new-inline-functional-type-conflict.2))))
-    (assert (ctype= type '(function (t) (values t &optional))))))
+    (assert (ctype= type '(function (t) (values (eql a) &optional))))))
 
 (with-test (:name :new-inline-functional-type-conflict.3)
   (ctu:file-compile

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


hooks/post-receive
-- 
SBCL