summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorStefan Monnier <monnier@iro.umontreal.ca>2022-10-16 12:01:47 -0400
committerStefan Monnier <monnier@iro.umontreal.ca>2022-10-16 12:01:47 -0400
commit13d6e8fa54843b0b087e5a9c266e4b7e0d709c3f (patch)
tree1c09984f5d78c711416d7748bf83051789a0ac00
parent0e5fc2345d8ec72fd8f7ad51ce1e42040e0e91da (diff)
downloademacs-13d6e8fa54843b0b087e5a9c266e4b7e0d709c3f.tar.gz
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.
-rw-r--r--lisp/emacs-lisp/byte-run.el5
-rw-r--r--lisp/emacs-lisp/bytecomp.el10
-rw-r--r--lisp/emacs-lisp/cl-generic.el6
-rw-r--r--lisp/help-fns.el2
-rw-r--r--lisp/progmodes/elisp-mode.el4
-rw-r--r--lisp/subr.el14
-rw-r--r--test/lisp/emacs-lisp/cl-generic-tests.el22
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