mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 09:14:18 +00:00
Fix recent test suite regression (bug#80177)
* lisp/emacs-lisp/cl-generic.el (cl--generic-make-function): Preserve advertised-calling-convention info. * test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-quote-optimization): Require `byte-opt` to fix the test when the compiler is not loaded yet. * lisp/progmodes/elisp-mode.el: Fix some >80column problems. (elisp--xref-format-extra) (elisp--xref-format): Make them constant, now that we don't have the purespace. Also, use %S since some of the elements don't necessarily have names and even if they do, we'd want to escape any funny characters in them to avoid ambiguities. (elisp--xref-find-definitions): Fix uses of `elisp--xref-format-extra` accordingly. Improve heuristic to distinguish proper `cl-defgeneric` from implicit ones. (elisp-eldoc-docstring-length-limit) (elisp-eldoc-funcall-with-docstring-length): Remove redundant `:group`. * lisp/cedet/mode-local.el (xref-mode-local-overload): Pass the override symbol rather than its name through `elisp--xref-format-extra`. * test/lisp/progmodes/elisp-mode-tests.el (find-defs-constructor): Adjust test to new text.
This commit is contained in:
Stefan Monnier
parent
762902c2c6
commit
9dcf0bc428
5 changed files with 70 additions and 50 deletions
|
|
@ -723,19 +723,23 @@ SYMBOL is a function that can be overridden."
|
|||
override (symbol-function override)))))
|
||||
|
||||
(when (and override override-file)
|
||||
(let ((meta-name (cons override major-mode))
|
||||
;; For the declaration:
|
||||
;;
|
||||
;;(define-mode-local-override xref-elisp-foo c-mode
|
||||
;;
|
||||
;; The override symbol name is
|
||||
;; "xref-elisp-foo-c-mode". The summary should match
|
||||
;; the declaration, so strip the mode from the
|
||||
;; symbol name.
|
||||
(summary (format elisp--xref-format-extra
|
||||
'define-mode-local-override
|
||||
(substring (symbol-name override) 0 (- (1+ (length (symbol-name major-mode)))))
|
||||
major-mode)))
|
||||
(let* ((meta-name (cons override major-mode))
|
||||
;; For the declaration:
|
||||
;;
|
||||
;;(define-mode-local-override xref-elisp-foo c-mode
|
||||
;;
|
||||
;; The override symbol name is
|
||||
;; "xref-elisp-foo-c-mode". The summary should match
|
||||
;; the declaration, so strip the mode from the
|
||||
;; symbol name.
|
||||
(overridesymbol
|
||||
(intern
|
||||
(substring (symbol-name override)
|
||||
0 (- (1+ (length (symbol-name major-mode)))))))
|
||||
(summary (format elisp--xref-format-extra
|
||||
'define-mode-local-override
|
||||
overridesymbol
|
||||
major-mode)))
|
||||
|
||||
(unless (xref-mode-local--override-present override xrefs)
|
||||
(push (elisp--xref-make-xref
|
||||
|
|
|
|||
|
|
@ -324,6 +324,9 @@ DEFAULT-BODY, if present, is used as the body of a default method.
|
|||
,@warnings
|
||||
(defalias ',name
|
||||
(cl-generic-define ',name ',args ',(nreverse options))
|
||||
;; FIXME: This docstring argument is used as circumstantial
|
||||
;; evidence that this generic function was defined via
|
||||
;; `cl-defgeneric' rather than only `cl-defmethod's.
|
||||
,(if (consp doc) ;An expression rather than a constant.
|
||||
`(help-add-fundoc-usage ,doc ',args)
|
||||
(help-add-fundoc-usage doc args)))
|
||||
|
|
@ -844,12 +847,18 @@ You might need to add: %S"
|
|||
;; at which point we replace the dummy with the real one.
|
||||
(with-memoization (cl--generic-lazy-function generic)
|
||||
(lambda (&rest args)
|
||||
(let ((real
|
||||
(cl--generic-make-next-function generic
|
||||
(cl--generic-dispatches generic)
|
||||
(cl--generic-method-table generic))))
|
||||
(let ((current-load-list nil))
|
||||
(defalias (cl--generic-name generic) real))
|
||||
(let* ((real
|
||||
(cl--generic-make-next-function generic
|
||||
(cl--generic-dispatches generic)
|
||||
(cl--generic-method-table generic)))
|
||||
(sym (cl--generic-name generic))
|
||||
(old-adv-cc (get-advertised-calling-convention
|
||||
(symbol-function sym))))
|
||||
(when (listp old-adv-cc)
|
||||
(set-advertised-calling-convention real old-adv-cc nil))
|
||||
(when (symbol-function sym)
|
||||
(let ((current-load-list nil))
|
||||
(defalias sym real)))
|
||||
(apply real args)))))
|
||||
|
||||
(defun cl--generic-make-next-function (generic dispatches methods)
|
||||
|
|
|
|||
|
|
@ -1249,17 +1249,13 @@ functions are annotated with \"<f>\" via the
|
|||
|
||||
(defun elisp--xref-backend () 'elisp)
|
||||
|
||||
;; WORKAROUND: This is nominally a constant, but the text properties
|
||||
;; are not preserved thru dump if use defconst. See bug#21237.
|
||||
(defvar elisp--xref-format
|
||||
#("(%s %s)"
|
||||
(defconst elisp--xref-format
|
||||
#("(%S %S)"
|
||||
1 3 (face font-lock-keyword-face)
|
||||
4 6 (face font-lock-function-name-face)))
|
||||
|
||||
;; WORKAROUND: This is nominally a constant, but the text properties
|
||||
;; are not preserved thru dump if use defconst. See bug#21237.
|
||||
(defvar elisp--xref-format-extra
|
||||
#("(%s %s %s)"
|
||||
(defconst elisp--xref-format-extra
|
||||
#("(%S %S %S)"
|
||||
1 3 (face font-lock-keyword-face)
|
||||
4 6 (face font-lock-function-name-face)))
|
||||
|
||||
|
|
@ -1539,22 +1535,28 @@ namespace but with lower confidence."
|
|||
;; defined in C; the doc strings from the C source have
|
||||
;; not been loaded yet. Second call will return "src/*.c"
|
||||
;; in file; handled by t case below.
|
||||
(push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs))
|
||||
(push (elisp--xref-make-xref
|
||||
nil symbol (help-C-file-name (symbol-function symbol)
|
||||
'subr))
|
||||
xrefs))
|
||||
|
||||
((and (setq doc (documentation symbol t))
|
||||
;; This doc string is defined in cl-macs.el cl-defstruct
|
||||
(string-match "Constructor for objects of type `\\(.*\\)'" doc))
|
||||
;; FIXME: This is hideously brittle!
|
||||
(string-match "Constructor for objects of type `\\(.*\\)'"
|
||||
doc))
|
||||
;; `symbol' is a name for the default constructor created by
|
||||
;; cl-defstruct, so return the location of the cl-defstruct.
|
||||
(let* ((type-name (match-string 1 doc))
|
||||
(type-symbol (intern type-name))
|
||||
(file (find-lisp-object-file-name type-symbol 'define-type))
|
||||
(file (find-lisp-object-file-name
|
||||
type-symbol 'define-type))
|
||||
(summary (format elisp--xref-format-extra
|
||||
'cl-defstruct
|
||||
(concat "(" type-name)
|
||||
(concat "(:constructor " (symbol-name symbol) "))"))))
|
||||
(push (elisp--xref-make-xref 'define-type type-symbol file summary) xrefs)
|
||||
))
|
||||
'cl-defstruct type-symbol
|
||||
`(:constructor ,symbol))))
|
||||
(push (elisp--xref-make-xref 'define-type type-symbol
|
||||
file summary)
|
||||
xrefs)))
|
||||
|
||||
((setq generic (cl--generic symbol))
|
||||
;; FIXME: move this to elisp-xref-find-def-functions, in cl-generic.el
|
||||
|
|
@ -1585,22 +1587,28 @@ namespace but with lower confidence."
|
|||
;; Default method has all t in specializers.
|
||||
(setq non-default (or non-default (not (equal t item)))))
|
||||
|
||||
(when (and file
|
||||
(or non-default
|
||||
(nth 2 info))) ;; assuming only co-located default has null doc string
|
||||
;; Assuming only co-located default has null doc string
|
||||
(when (and file (or non-default (nth 2 info)))
|
||||
(if specializers
|
||||
(let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info))))
|
||||
(push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))
|
||||
(let ((summary (format elisp--xref-format-extra
|
||||
'cl-defmethod symbol
|
||||
(nth 1 info))))
|
||||
(push (elisp--xref-make-xref 'cl-defmethod met-name
|
||||
file summary)
|
||||
xrefs))
|
||||
|
||||
(let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()")))
|
||||
(push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs))))
|
||||
(let ((summary (format elisp--xref-format-extra
|
||||
'cl-defmethod symbol ())))
|
||||
(push (elisp--xref-make-xref 'cl-defmethod met-name
|
||||
file summary)
|
||||
xrefs))))
|
||||
))
|
||||
|
||||
(if (and (setq doc (documentation symbol t))
|
||||
;; This doc string is created somewhere in
|
||||
;; cl--generic-make-function for an implicit
|
||||
;; defgeneric.
|
||||
(string-match "\n\n(fn ARG &rest ARGS)" doc))
|
||||
;; FIXME: We rely on the fact that `cl-defgeneric' sets
|
||||
;; a `function-documentation' property (via the third arg of
|
||||
;; `defalias'), whereas implicit declaration of a generic via
|
||||
;; `cl-defmethod' doesn't.
|
||||
(if (null (get symbol 'function-documentation))
|
||||
;; This symbol is an implicitly defined defgeneric, so
|
||||
;; don't return it.
|
||||
nil
|
||||
|
|
@ -2238,7 +2246,6 @@ Intended for `eldoc-documentation-functions' (which see)."
|
|||
(defcustom elisp-eldoc-docstring-length-limit 1000
|
||||
"Maximum length of doc strings displayed by elisp ElDoc functions."
|
||||
:type 'natnum
|
||||
:group 'elisp
|
||||
:version "31.1")
|
||||
|
||||
(defcustom elisp-eldoc-funcall-with-docstring-length 'short
|
||||
|
|
@ -2248,7 +2255,6 @@ Otherwise if set to `full', display full doc string."
|
|||
:type '(choice
|
||||
(const :tag "Short" short)
|
||||
(const :tag "Full" full))
|
||||
:group 'elisp
|
||||
:version "31.1")
|
||||
|
||||
(defun elisp-eldoc-funcall-with-docstring (callback &rest _ignored)
|
||||
|
|
|
|||
|
|
@ -80,6 +80,7 @@
|
|||
(ert-deftest pcase-tests-quote-optimization ()
|
||||
;; FIXME: We could/should also test that we get a corresponding
|
||||
;; "shadowed branch" warning.
|
||||
(require 'byte-opt) ;; FIXME: Needed for pcase to see that `consp' is `pure'.
|
||||
(should-not (pcase-tests-grep
|
||||
'FOO (macroexpand '(pcase EXP
|
||||
(`(,_ . ,_) (BAR))
|
||||
|
|
|
|||
|
|
@ -407,7 +407,7 @@ to (xref-elisp-test-descr-to-target xref)."
|
|||
;; cl-defstruct location.
|
||||
(list
|
||||
(cons
|
||||
(xref-make "(cl-defstruct (xref-elisp-location (:constructor xref-make-elisp-location)))"
|
||||
(xref-make "(cl-defstruct xref-elisp-location (:constructor xref-make-elisp-location))"
|
||||
(xref-make-elisp-location
|
||||
'xref-elisp-location 'define-type
|
||||
(expand-file-name "../../../lisp/progmodes/elisp-mode.el" emacs-test-dir)))
|
||||
|
|
|
|||
Loading…
Reference in a new issue