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:
parent
eca2cc00b6
commit
3f72004961
2 changed files with 28 additions and 7 deletions
|
|
@ -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)
|
||||||
|
|
|
||||||
|
|
@ -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)."
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue