master 109ca1b: Warn about arity errors in inlining calls (bug#12299)

[Mattias Engdegård]

branch: master
commit 109ca1bd00b56ba66b123b505d8c2187fded0ef7
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 lisp/emacs-lisp/byte-opt.el                        |  5 ++-
 lisp/emacs-lisp/bytecomp.el                        | 37 ++++++++++++++++------
 .../bytecomp-resources/warn-callargs-defsubst.el   |  5 +++
 test/lisp/emacs-lisp/bytecomp-tests.el             |  3 ++
 4 files changed, 39 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 341643c..ad9f827 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 2968f1a..f615006 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)))
 
diff --git a/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el 
b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
new file mode 100644
index 0000000..3a29128
--- /dev/null
+++ b/test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el
@@ -0,0 +1,5 @@
+;;; -*- lexical-binding: t -*-
+(defsubst warn-callargs-defsubst-f1 (_x)
+  nil)
+(defun warn-callargs-defsubst-f2 ()
+  (warn-callargs-defsubst-f1 1 2))
diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el 
b/test/lisp/emacs-lisp/bytecomp-tests.el
index 33413f5..7c40f7e 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -700,6 +700,9 @@ byte-compiled.  Run with dynamic binding."
 (bytecomp--define-warning-file-test "warn-callargs.el"
                             "with 2 arguments, but accepts only 1")
 
+(bytecomp--define-warning-file-test "warn-callargs-defsubst.el"
+                            "with 2 arguments, but accepts only 1")
+
 (bytecomp--define-warning-file-test "warn-defcustom-nogroup.el"
                             "fails to specify containing group")