From: Mattias Engdegård <mattiase@acm.org>
Date: Thu, 22 Jul 2021 13:00:17 +0000 (+0200)
Subject: Warn about arity errors in inlining calls (bug#12299)
X-Git-Tag: emacs-28.0.90~1738
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=109ca1bd00b56ba66b123b505d8c2187fded0ef7;p=emacs.git

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.
---

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)))
 
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 00000000000..3a29128cf3a
--- /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 33413f5a002..7c40f7ebca3 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")