master: Catch type mismatches when calling XEPs

stassats via Sbcl-commits <[email protected]> Wed, 06 May 2026 01:37:43 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  187f57e2244946c0953dcd1c99c3a28553c557ec (commit)
      from  ec1f07e79ac25d31a485eb38d389e27eecbbb441 (commit)

- Log -----------------------------------------------------------------
commit 187f57e2244946c0953dcd1c99c3a28553c557ec
Author: Stas Boukarev <[email protected]>
Date:   Wed May 6 04:11:33 2026 +0300

    Catch type mismatches when calling XEPs
---
 src/compiler/locall.lisp |  3 ++-
 tests/bad-code.pure.lisp | 10 ++++++++++
 2 files changed, 12 insertions(+), 1 deletion(-)

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 6d7d3ea9b..4de0d91ac 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -344,7 +344,8 @@
             (leaf-ever-used xep) t
             (functional-entry-fun xep) fun
             (functional-entry-fun fun) xep
-            (component-reanalyze *current-component*) t)
+            (component-reanalyze *current-component*) t
+            (leaf-type xep) (definition-type fun))
       (reoptimize-component *current-component* :maybe)
       (locall-analyze-xep-entry-point fun)
       xep)))
diff --git a/tests/bad-code.pure.lisp b/tests/bad-code.pure.lisp
index 2589f572f..c08839e6b 100644
--- a/tests/bad-code.pure.lisp
+++ b/tests/bad-code.pure.lisp
@@ -1080,3 +1080,13 @@
                          (compile nil `(lambda () #',sym)))))))
     (assert (search "special operator IF was found" (try 'if)))
     (assert (search "macro COND was found" (try 'cond)))))
+
+(with-test (:name :xep-fun-type-mismatch)
+  (assert
+   (nth-value 2
+              (checked-compile `(lambda (n)
+                                  (funcall (if n
+                                               (lambda (a) (+ a 2))
+                                               (lambda (a) (+ a 1)))
+                                           1 2))
+                               :allow-warnings t))))

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


hooks/post-receive
-- 
SBCL