branch: externals/hyperbole
commit a4c41006cf18515cc15b289a9057c6543bd65e80
Author: bw <r...@gnu.org>
Commit: bw <r...@gnu.org>
*ert* buffer - make {.} jump to interactively defined test def
Previously, had to have loaded the test def from a file; now can use
TAGS files to find its location. Use this incantation to set this up.
(setq find-function-regexp-alist
(assq-delete-all 'ert--test find-function-regexp-alist))
;; Could also set this to `smart-lisp-find-tag' instead of
`xref-find-definitions'.
(add-to-list 'find-function-regexp-alist '(ert--test .
xref-find-definitions))
---
ChangeLog | 11 +++++++++++
hmouse-tag.el | 23 +++++++++++++++++------
hypb-ert.el | 30 +++++++++++++++++-------------
3 files changed, 45 insertions(+), 19 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index 1a63095476..73b6e5f1d7 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,16 @@
2024-01-05 Bob Weiner <r...@gnu.org>
+* hypb-ert.el (hypb-ert-run-test-at-definition): Accept a symbol as
+ a 'test-name' argument.
+
+* hmouse-tag.el (smart-emacs-lisp-mode-p): Include 'ert-results-mode'.
+ (smart-lisp-find-tag): Allow 'tag' arg to be a symbol,
+ not just a string. This allows it to be used as a target function
+ in 'find-function-regexp-alist' which is used in the ert results buffer
+ with the {.} command to jump to the ert test definition at point.
+ (xref-definitions, xref-definition): Rewrite to handle
+ ert-deftests.
+
* Makefile (test-all): Change 'ert-run-tests-interactively' to
'ert-run-tests-batch' because this shows tracebacks of any tests that
fail in the *Messages* buffer, speeding debugging. Although it does
diff --git a/hmouse-tag.el b/hmouse-tag.el
index e67c427f40..00c54cc6bf 100644
--- a/hmouse-tag.el
+++ b/hmouse-tag.el
@@ -3,7 +3,7 @@
;; Author: Bob Weiner
;;
;; Orig-Date: 24-Aug-91
-;; Last-Mod: 29-Dec-23 at 00:52:05 by Bob Weiner
+;; Last-Mod: 5-Jan-24 at 14:02:46 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -36,12 +36,20 @@
(max (point-min) (if (eolp) (1- (point)) (point)))
'xref-item))
(when (not (fboundp 'xref-definition))
- (defun xref-definition (identifier)
- "Return the first definition of string IDENTIFIER."
- (car (xref-backend-definitions (xref-find-backend) identifier)))
(defun xref-definitions (identifier)
"Return a list of all definitions of string IDENTIFIER."
- (xref-backend-definitions (xref-find-backend) identifier))
+ (let* ((elisp-flag (smart-emacs-lisp-mode-p))
+ (xref-backend (or (and elisp-flag
+ (fboundp 'ert-test-boundp)
+ (ert-test-boundp identifier)
+ (boundp 'xref-etags-mode)
+ 'etags)
+ (xref-find-backend)))
+ (xref-items (xref-backend-definitions xref-backend identifier)))
+ xref-items))
+ (defun xref-definition (identifier)
+ "Return the first definition of string IDENTIFIER."
+ (car (xref-definitions identifier)))
(defun xref-item-buffer (item)
"Return the buffer in which xref ITEM is defined."
(marker-buffer (save-excursion (xref-location-marker (xref-item-location
item)))))
@@ -422,7 +430,8 @@ If:
;; Beyond Lisp files, Emacs Lisp symbols appear frequently in Byte-Compiled
;; buffers, debugger buffers, program ChangeLog buffers, Help buffers,
;; *Warnings*, *Flymake log* and *Flymake diagnostics... buffers.
- (or (memq major-mode #'(emacs-lisp-mode lisp-interaction-mode debugger-mode))
+ (or (memq major-mode #'(emacs-lisp-mode lisp-interaction-mode
+ debugger-mode ert-results-mode))
(string-match-p (concat "\\`\\*\\(Warnings\\|Flymake
log\\|Compile-Log\\(-Show\\)?\\)\\*"
"\\|\\`\\*Flymake diagnostics")
(buffer-name))
@@ -698,6 +707,8 @@ Use `hpath:display-buffer' to show definition or
documentation."
(if current-prefix-arg
"Show doc for" "Find")))
current-prefix-arg))
+ (when (and tag (symbolp tag))
+ (setq tag (symbol-name tag)))
(unless (stringp tag)
(setq tag (if (stringp hkey-value) hkey-value (smart-lisp-at-tag-p t))))
(let* ((elisp-flag (smart-emacs-lisp-mode-p))
diff --git a/hypb-ert.el b/hypb-ert.el
index 389461633c..ce5745718a 100644
--- a/hypb-ert.el
+++ b/hypb-ert.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org> and Bob Weiner <r...@gnu.org>
;;
;; Orig-Date: 31-Mar-21 at 21:11:00
-;; Last-Mod: 4-Jan-24 at 14:10:39 by Mats Lidell
+;; Last-Mod: 5-Jan-24 at 15:11:42 by Bob Weiner
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -32,17 +32,19 @@
(eval-and-compile (mapc #'require '(lisp-mode hload-path ert hact hbut hargs)))
(defun hypb-ert-message-function (_msg-pat &rest _args)
- "Ignore messages ert outputs so can display messages from tests run."
+ "Ignore the messages ert outputs so can display its test messages."
;; (identity (apply #'format msg-pat args)))))))
nil)
-(defun hypb-ert (selector)
+(defun hypb-ert (test-selector)
+ "Run all ert TEST-SELECTOR tests.
+See documentation for `ert-select-tests' for TEST-SELECTOR types."
(if (memq 'message-fn (actype:params #'ert-run-tests-interactively))
;; Suppress ert messages so last test case message stays in the
minibuffer;
;; 3rd arg message-fn available only in Emacs 27 and earlier
(with-suppressed-warnings ((callargs ert))
- (ert selector nil #'hypb-ert-message-function))
- (ert selector))
+ (ert test-selector nil #'hypb-ert-message-function))
+ (ert test-selector))
;; ERT can display a long internal data structure as a result, so
;; replace it in the minibuffer with a blank message.
(message ""))
@@ -68,6 +70,7 @@ See documentation for `ert-select-tests' for TEST-SELECTOR
types."
(directory-files (expand-file-name "test" hyperb:dir) nil
"^[a-zA-Z].*\\.el$")))
(defun hypb-ert-require-libraries ()
+ "Load all Hyperbole ert test symbols."
(mapc #'require (hypb-ert-get-require-symbols)))
(defal hyperbole-run-test "hypb-ert-run-test"
@@ -78,7 +81,7 @@ See documentation for `ert-select-tests' for TEST-SELECTOR
types."
See documentation for `ert-select-tests' for TEST-SELECTOR types.")
(defun hypb-ert-run-all-tests ()
- "Run every ert test."
+ "Run every Hyperbole ert test."
(interactive)
(hypb-ert-require-libraries)
(hypb-ert t))
@@ -102,19 +105,20 @@ With optional START-END-FLAG, return a list of (test-name
start-pos end-pos)."
(list (match-string-no-properties 2) (match-beginning 2) (match-end
2))
(match-string-no-properties 2))))))
-(defun hypb-ert-run-test-at-definition (test-name &optional debug-it)
- "Assume on the name in the first line of an ert test def, eval and run the
test.
-With optional DEBUG-IT non-nil (when the assist-key is pressed), edebug the
-test when it is run."
- (let ((test-sym (intern-soft test-name)))
+(defun hypb-ert-run-test-at-definition (test-name &optional edebug-it)
+ "Eval and run the ert TEST-NAME defined at point.
+Assume point is on the text of the first line of an ert test def,
+With optional EDEBUG-IT non-nil (when the assist-key is pressed),
+edebug the test when it is run."
+ (let ((test-sym (if (symbolp test-name) test-name (intern-soft test-name))))
;; Ensure run the latest version of the test, either with the
;; edebugger if already instrumented for it; otherwise, with the
;; normal evaluator.
- (if (and test-sym debug-it)
+ (if (and test-sym edebug-it)
(edebug-defun)
(eval-defun nil)
(setq test-sym (intern-soft test-name))
- (when (and test-sym debug-it)
+ (when (and test-sym edebug-it)
(edebug-defun)))
(setq test-sym (intern-soft test-name))
(when (and test-sym (ert-test-boundp test-sym))
