1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-04 11:00:45 -08:00

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.
This commit is contained in:
Mattias Engdegård 2025-06-17 20:18:53 +02:00
parent eca2cc00b6
commit 3f72004961
2 changed files with 28 additions and 7 deletions

View file

@ -1454,13 +1454,19 @@ when printing the error message."
(env (cdr (assq name list)))) (env (cdr (assq name list))))
(or env (or env
(let ((fn name)) (let ((fn name))
(while (and (symbolp fn) (while
(fboundp fn) (and (symbolp fn)
(or (symbolp (symbol-function fn)) (fboundp fn)
(consp (symbol-function fn)) (let ((s (symbol-function fn)))
(and
(or (symbolp s)
(consp s)
(and (not macro-p) (and (not macro-p)
(compiled-function-p (symbol-function fn))))) (or (closurep s)
(setq fn (symbol-function fn))) (compiled-function-p s))))
(progn
(setq fn s)
t)))))
(let ((advertised (get-advertised-calling-convention (let ((advertised (get-advertised-calling-convention
(if (and (symbolp fn) (fboundp fn)) (if (and (symbolp fn) (fboundp fn))
;; Could be a subr. ;; Could be a subr.
@ -1471,7 +1477,8 @@ when printing the error message."
(if macro-p (if macro-p
`(macro lambda ,advertised) `(macro lambda ,advertised)
`(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) ((not (consp fn)) nil)
((eq 'macro (car fn)) (cdr fn)) ((eq 'macro (car fn)) (cdr fn))
(macro-p nil) (macro-p nil)

View file

@ -1357,6 +1357,20 @@ byte-compiled. Run with dynamic binding."
(concat ";;; -*-lexical-binding:nil-*-\n" some-code))) (concat ";;; -*-lexical-binding:nil-*-\n" some-code)))
(should (cookie-warning 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 () (ert-deftest bytecomp-tests--unescaped-char-literals ()
"Check that byte compiling warns about unescaped character "Check that byte compiling warns about unescaped character
literals (Bug#20852)." literals (Bug#20852)."