diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/byte-run.el | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 10 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cl-generic.el | 6 |
3 files changed, 15 insertions, 6 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))))) |