From: Mattias Engdegård <mattiase@acm.org>
Date: Tue, 17 Jun 2025 18:18:53 +0000 (+0200)
Subject: Fix function arity check for noncompiled callees (bug#78685)
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=2b8ea0032890ed71110007dbc32a7768652c0a28;p=emacs.git

Fix function arity check for noncompiled callees (bug#78685)

This fixes a regression from Emacs 29, and is the second attempt after
the later reverted 8b0f5b0597.

* lisp/emacs-lisp/bytecomp.el (byte-compile-fdefinition):
Make it work for functions that aren't compiled.
* test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--f):
(bytecomp-tests--warn-arity-noncompiled-callee): Add test.

(cherry picked from commit 3f720049614d825bd83d584e07d68e6461cf9708)
---

diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 74385e79a80..452765c4c38 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1461,13 +1461,19 @@ when printing the error message."
 	 (env (cdr (assq name list))))
     (or env
 	(let ((fn name))
-	  (while (and (symbolp fn)
-		      (fboundp fn)
-		      (or (symbolp (symbol-function fn))
-			  (consp (symbol-function fn))
+	  (while
+              (and (symbolp fn)
+		   (fboundp fn)
+                   (let ((s (symbol-function fn)))
+                     (and
+		      (or (symbolp s)
+			  (consp s)
 			  (and (not macro-p)
-			       (compiled-function-p (symbol-function fn)))))
-	    (setq fn (symbol-function fn)))
+                               (or (closurep s)
+			           (compiled-function-p s))))
+                      (progn
+	                (setq fn s)
+                        t)))))
           (let ((advertised (get-advertised-calling-convention
                              (if (and (symbolp fn) (fboundp fn))
                                  ;; Could be a subr.
@@ -1478,7 +1484,8 @@ when printing the error message."
               (if macro-p
                   `(macro lambda ,advertised)
                 `(lambda ,advertised)))
-             ((and (not macro-p) (compiled-function-p fn)) fn)
+             ((and (not macro-p) (or (closurep fn) (compiled-function-p fn)))
+              fn)
              ((not (consp fn)) nil)
              ((eq 'macro (car fn)) (cdr fn))
              (macro-p nil)
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el
index 8b0c1dad4c0..d1f272f7a4d 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -1357,6 +1357,20 @@ byte-compiled.  Run with dynamic binding."
                      (concat ";;; -*-lexical-binding:nil-*-\n" some-code)))
         (should (cookie-warning some-code))))))
 
+(defun bytecomp-tests--f (x y &optional u v) (list x y u v))
+
+(ert-deftest bytecomp-tests--warn-arity-noncompiled-callee ()
+  "Check that calls to non-compiled functions are arity-checked (bug#78685)"
+  (should (not (compiled-function-p (symbol-function 'bytecomp-tests--f))))
+  (let* ((source (concat ";;; -*-lexical-binding:t-*-\n"
+                         "(defun my-fun () (bytecomp-tests--f 11))\n"))
+         (lexical-binding t)
+         (log (bytecomp-tests--log-from-compilation source)))
+    (should (string-search
+             (concat "Warning: `bytecomp-tests--f' called with 1 argument,"
+                     " but requires 2-4")
+             log))))
+
 (ert-deftest bytecomp-tests--unescaped-char-literals ()
   "Check that byte compiling warns about unescaped character
 literals (Bug#20852)."