1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-24 06:20:43 -08:00

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.
This commit is contained in:
Stefan Monnier 2022-10-16 12:01:47 -04:00
parent 0e5fc2345d
commit 13d6e8fa54
7 changed files with 51 additions and 12 deletions

View file

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

View file

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

View file

@ -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)))))