From cb9d873871eb445ad18b2a89f3c4ba7e6a4d3ef3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Mattias=20Engdeg=C3=A5rd?= <mattiase@acm.org>
Date: Thu, 22 Jul 2021 15:00:17 +0200
Subject: [PATCH] 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                   | 58 +++++++++++++++----
 .../warn-callargs-defsubst.el                 |  5 ++
 test/lisp/emacs-lisp/bytecomp-tests.el        |  3 +
 4 files changed, 60 insertions(+), 11 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/bytecomp-resources/warn-callargs-defsubst.el

diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index 341643c7d1..ad9f827171 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -274,6 +274,7 @@ byte-compile-inline-expand
       ((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 @@ byte-compile-inline-expand
                ;; 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 2968f1af5d..a5cb5477d8 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1477,6 +1477,51 @@ byte-compile-function-warn
           (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* ((desc (aref bytecode 0))
+           (actual-args (length (cdr form)))
+            min-args max-args)
+      (if (listp desc)
+        ;; Old-style bytecode: decode the signature.
+        (let ((n 0))
+          (setq max-args 0)
+          (while desc
+            (pcase (car desc)
+              ('&optional
+               (setq min-args n)
+               (setq desc (cdr desc)))
+              ('&rest
+               (unless min-args (setq min-args n))
+               (setq max-args nil)
+               (setq desc nil))
+              (_
+               (setq max-args (1+ max-args))
+               (setq n (1+ n))
+               (setq desc (cdr desc)))))
+          (unless min-args (setq min-args n)))
+        ;; Modern bytecode.
+        (setq min-args (logand desc 127))
+        (setq max-args (and (= (logand desc 128) 0)
+                            (ash desc -8))))
+      (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 +1536,9 @@ byte-compile-callargs-warn
 	(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 0000000000..3a29128cf3
--- /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 33413f5a00..7c40f7ebca 100644
--- a/test/lisp/emacs-lisp/bytecomp-tests.el
+++ b/test/lisp/emacs-lisp/bytecomp-tests.el
@@ -700,6 +700,9 @@ "warn-autoload-not-on-top-level.el"
 (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")
 
-- 
2.21.1 (Apple Git-122.3)

