From 13d6e8fa54843b0b087e5a9c266e4b7e0d709c3f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 16 Oct 2022 12:01:47 -0400 Subject: 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 9db84c31b88..a33808ab92d 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 74ba8984f29..3ceb5da804f 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 b3ade3b8943..7b6d43e572b 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 eef895ae88b..e29f763dabc 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 7e7ea6aeb9e..537b9484bd5 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 56ce9fa69b9..08dfe7aa430 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 56b766769ea..8e807b15915 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 -- cgit v1.2.1