summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorMattias EngdegÄrd <mattiase@acm.org>2021-07-22 15:00:17 +0200
committerMattias EngdegÄrd <mattiase@acm.org>2021-07-23 15:19:01 +0200
commit109ca1bd00b56ba66b123b505d8c2187fded0ef7 (patch)
tree7da2c0b5b4cf4df05e90b324dfe430304269c7b5 /lisp/emacs-lisp
parent4d172946c3953b3990182d794e5bda6a11646e29 (diff)
downloademacs-109ca1bd00b56ba66b123b505d8c2187fded0ef7.tar.gz
emacs-109ca1bd00b56ba66b123b505d8c2187fded0ef7.tar.bz2
emacs-109ca1bd00b56ba66b123b505d8c2187fded0ef7.zip
Warn about arity errors in inlining calls (bug#12299)
Wrong number of arguments in inlining function calls (to `defsubst` or explicitly using `inline`) did not result in warnings, or in very cryptic ones. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Add calls to `byte-compile--check-arity-bytecode`. * lisp/emacs-lisp/bytecomp.el (byte-compile-emit-callargs-warn) (byte-compile--check-arity-bytecode): New functions. (byte-compile-callargs-warn): Use factored-out function. * test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el: * test/lisp/emacs-lisp/bytecomp-tests.el ("warn-callargs-defsubst.el"): New test case.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r--lisp/emacs-lisp/byte-opt.el5
-rw-r--r--lisp/emacs-lisp/bytecomp.el37
2 files changed, 31 insertions, 11 deletions
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 341643c7d16..ad9f827171a 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -274,6 +274,7 @@ Earlier variables shadow later ones with the same name.")
((pred byte-code-function-p)
;; (message "Inlining byte-code for %S!" name)
;; The byte-code will be really inlined in byte-compile-unfold-bcf.
+ (byte-compile--check-arity-bytecode form fn)
`(,fn ,@(cdr form)))
((or `(lambda . ,_) `(closure . ,_))
;; While byte-compile-unfold-bcf can inline dynbind byte-code into
@@ -300,7 +301,9 @@ Earlier variables shadow later ones with the same name.")
;; surrounded the `defsubst'.
(byte-compile-warnings nil))
(byte-compile name))
- `(,(symbol-function name) ,@(cdr form))))
+ (let ((bc (symbol-function name)))
+ (byte-compile--check-arity-bytecode form bc)
+ `(,bc ,@(cdr form)))))
(_ ;; Give up on inlining.
form))))
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 2968f1af5df..f6150069e81 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1477,6 +1477,30 @@ when printing the error message."
(push (list f byte-compile-last-position nargs)
byte-compile-unresolved-functions)))))
+(defun byte-compile-emit-callargs-warn (name actual-args min-args max-args)
+ (byte-compile-set-symbol-position name)
+ (byte-compile-warn
+ "%s called with %d argument%s, but %s %s"
+ name actual-args
+ (if (= 1 actual-args) "" "s")
+ (if (< actual-args min-args)
+ "requires"
+ "accepts only")
+ (byte-compile-arglist-signature-string (cons min-args max-args))))
+
+(defun byte-compile--check-arity-bytecode (form bytecode)
+ "Check that the call in FORM matches that allowed by BYTECODE."
+ (when (and (byte-code-function-p bytecode)
+ (byte-compile-warning-enabled-p 'callargs))
+ (let* ((actual-args (length (cdr form)))
+ (arity (func-arity bytecode))
+ (min-args (car arity))
+ (max-args (and (numberp (cdr arity)) (cdr arity))))
+ (when (or (< actual-args min-args)
+ (and max-args (> actual-args max-args)))
+ (byte-compile-emit-callargs-warn
+ (car form) actual-args min-args max-args)))))
+
;; Warn if the form is calling a function with the wrong number of arguments.
(defun byte-compile-callargs-warn (form)
(let* ((def (or (byte-compile-fdefinition (car form) nil)
@@ -1491,16 +1515,9 @@ when printing the error message."
(setcdr sig nil))
(if sig
(when (or (< ncall (car sig))
- (and (cdr sig) (> ncall (cdr sig))))
- (byte-compile-set-symbol-position (car form))
- (byte-compile-warn
- "%s called with %d argument%s, but %s %s"
- (car form) ncall
- (if (= 1 ncall) "" "s")
- (if (< ncall (car sig))
- "requires"
- "accepts only")
- (byte-compile-arglist-signature-string sig))))
+ (and (cdr sig) (> ncall (cdr sig))))
+ (byte-compile-emit-callargs-warn
+ (car form) ncall (car sig) (cdr sig))))
(byte-compile-format-warn form)
(byte-compile-function-warn (car form) (length (cdr form)) def)))