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 74385e79a80e5b80612d3aa5b8bce6573f1980d9..452765c4c380b33bb3b8b5c2ed24786505c602de 100644 (file)
--- 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 8b0c1dad4c03fd49ebee4ff47cea90a9ccc52fac..d1f272f7a4dd5dcda82b3dbf9709eed28b2809dc 100644 (file)
--- 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)."