master 13d6e8fa54: cl-generic: Fix `advertised-calling-convention` declarations

[Stefan Monnier]

branch: master
commit 13d6e8fa54843b0b087e5a9c266e4b7e0d709c3f
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    cl-generic: Fix `advertised-calling-convention` declarations
    
    * lisp/emacs-lisp/cl-generic.el (cl-generic-define-method):
    Preserve the `advertised-calling-convention`, if any (bug#58563).
    
    * lisp/subr.el (declare): Warn when we hit this.
    
    * lisp/emacs-lisp/byte-run.el (get-advertised-calling-convention): New fun.
    * lisp/progmodes/elisp-mode.el (elisp-get-fnsym-args-string):
    * lisp/help-fns.el (help-fns--signature):
    * lisp/emacs-lisp/bytecomp.el (byte-compile-fdefinition): Use it.
    
    * test/lisp/emacs-lisp/cl-generic-tests.el (cl-generic-tests--acc): New fun.
    (cl-generic-tests--advertised-calling-convention-bug58563): New test.
---
 lisp/emacs-lisp/byte-run.el              |  5 +++++
 lisp/emacs-lisp/bytecomp.el              | 10 +++++-----
 lisp/emacs-lisp/cl-generic.el            |  6 +++++-
 lisp/help-fns.el                         |  2 +-
 lisp/progmodes/elisp-mode.el             |  4 ++--
 lisp/subr.el                             | 14 +++++++++++---
 test/lisp/emacs-lisp/cl-generic-tests.el | 22 ++++++++++++++++++++++
 7 files changed, 51 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el
index 9db84c31b8..a33808ab92 100644
--- a/lisp/emacs-lisp/byte-run.el
+++ b/lisp/emacs-lisp/byte-run.el
@@ -481,6 +481,11 @@ convention was modified."
   (puthash (indirect-function function) signature
            advertised-signature-table))
 
+(defun get-advertised-calling-convention (function)
+  "Get the advertised SIGNATURE of FUNCTION.
+Return t if there isn't any."
+  (gethash function advertised-signature-table t))
+
 (defun make-obsolete (obsolete-name current-name when)
   "Make the byte-compiler warn that function OBSOLETE-NAME is obsolete.
 OBSOLETE-NAME should be a function name or macro name (a symbol).
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 74ba8984f2..3ceb5da804 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -1405,11 +1405,11 @@ when printing the error message."
                          (and (not macro-p)
                               (compiled-function-p (symbol-function fn)))))
            (setq fn (symbol-function fn)))
-          (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn))
-                                         ;; Could be a subr.
-                                         (symbol-function fn)
-                                       fn)
-                                     advertised-signature-table t)))
+          (let ((advertised (get-advertised-calling-convention
+                             (if (and (symbolp fn) (fboundp fn))
+                                 ;; Could be a subr.
+                                 (symbol-function fn)
+                               fn))))
             (cond
              ((listp advertised)
               (if macro-p
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index b3ade3b894..7b6d43e572 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -650,13 +650,17 @@ The set of acceptable TYPEs (also called 
\"specializers\") is defined
                                      (cl--generic-name generic)
                                      qualifiers specializers))
                   current-load-list :test #'equal)
-      (let (;; Prevent `defalias' from recording this as the definition site of
+      (let ((old-adv-cc (get-advertised-calling-convention
+                         (symbol-function sym)))
+            ;; Prevent `defalias' from recording this as the definition site of
             ;; the generic function.
             current-load-list
             ;; BEWARE!  Don't purify this function definition, since that leads
             ;; to memory corruption if the hash-tables it holds are modified
             ;; (the GC doesn't trace those pointers).
             (purify-flag nil))
+        (when (listp old-adv-cc)
+          (set-advertised-calling-convention gfun old-adv-cc nil))
         ;; But do use `defalias', so that it interacts properly with nadvice,
         ;; e.g. for tracing/debug-on-entry.
         (defalias sym gfun)))))
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index eef895ae88..e29f763dab 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -669,7 +669,7 @@ the C sources, too."
   "Insert usage at point and return docstring.  With highlighting."
   (if (keymapp function)
       doc                       ; If definition is a keymap, skip arglist note.
-    (let* ((advertised (gethash real-def advertised-signature-table t))
+    (let* ((advertised (get-advertised-calling-convention real-def))
            (arglist (if (listp advertised)
                         advertised (help-function-arglist real-def)))
            (usage (help-split-fundoc doc function)))
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 7e7ea6aeb9..537b9484bd 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -1826,8 +1826,8 @@ or elsewhere, return a 1-line docstring."
                (eq 'function (aref elisp--eldoc-last-data 2)))
           (aref elisp--eldoc-last-data 1))
          (t
-          (let* ((advertised (gethash (indirect-function sym)
-                                       advertised-signature-table t))
+          (let* ((advertised (get-advertised-calling-convention
+                               (indirect-function sym)))
                   doc
                  (args
                   (cond
diff --git a/lisp/subr.el b/lisp/subr.el
index 56ce9fa69b..08dfe7aa43 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -344,7 +344,7 @@ in compilation warnings about unused variables.
              ;; FIXME: This let often leads to "unused var" warnings.
              `((let ((,var ,counter)) ,@(cddr spec)))))))
 
-(defmacro declare (&rest _specs)
+(defmacro declare (&rest specs)
   "Do not evaluate any arguments, and return nil.
 If a `declare' form appears as the first form in the body of a
 `defun' or `defmacro' form, SPECS specifies various additional
@@ -355,8 +355,16 @@ The possible values of SPECS are specified by
 `defun-declarations-alist' and `macro-declarations-alist'.
 
 For more information, see info node `(elisp)Declare Form'."
-  ;; FIXME: edebug spec should pay attention to defun-declarations-alist.
-  nil)
+  ;; `declare' is handled directly by `defun/defmacro' rather than here.
+  ;; If we get here, it's because there's a `declare' somewhere not attached
+  ;; to a `defun/defmacro', i.e. a `declare' which doesn't do what it's
+  ;; intended to do.
+  (let ((form `(declare . ,specs)))  ;; FIXME: WIBNI we had &whole?
+    (macroexp-warn-and-return
+     (format-message "Stray `declare' form: %S" form)
+     ;; Make a "unique" harmless form to circumvent
+     ;; the cache in `macroexp-warn-and-return'.
+     `(progn ',form nil) nil 'compile-only)))
 
 (defmacro ignore-errors (&rest body)
   "Execute BODY; if an error occurs, return nil.
diff --git a/test/lisp/emacs-lisp/cl-generic-tests.el 
b/test/lisp/emacs-lisp/cl-generic-tests.el
index 56b766769e..8e807b1591 100644
--- a/test/lisp/emacs-lisp/cl-generic-tests.el
+++ b/test/lisp/emacs-lisp/cl-generic-tests.el
@@ -297,5 +297,27 @@ Edebug symbols (Bug#42672)."
                      (intern "cl-defgeneric/edebug/method/2 (number)")
                      'cl-defgeneric/edebug/method/2))))))
 
+(cl-defgeneric cl-generic-tests--acc (x &optional y)
+  (declare (advertised-calling-convention (x) "671.2")))
+
+(cl-defmethod cl-generic-tests--acc ((x float)) (+ x 5.0))
+
+(ert-deftest cl-generic-tests--advertised-calling-convention-bug58563 ()
+  (should (equal (get-advertised-calling-convention
+                  (indirect-function 'cl-generic-tests--acc))
+                 '(x)))
+  (should
+   (condition-case err
+       (let ((lexical-binding t)
+             (byte-compile-debug t)
+             (byte-compile-error-on-warn t))
+         (byte-compile '(cl-defmethod cl-generic-tests--acc ((x list))
+                          (declare (advertised-calling-convention (y) "1.1"))
+                          (cons x '(5 5 5 5 5))))
+         nil)
+     (error
+      (and (eq 'error (car err))
+           (string-match "Stray.*declare" (cadr err)))))))
+
 (provide 'cl-generic-tests)
 ;;; cl-generic-tests.el ends here