diff options
| author | Glenn Morris | 2017-03-02 15:40:15 -0500 |
|---|---|---|
| committer | Glenn Morris | 2017-03-02 15:40:15 -0500 |
| commit | dacafa8c30cdae92f934512664fd2d322d91432b (patch) | |
| tree | c3903415fc9811f858f30ab57836230ed1354085 | |
| parent | d0d26c1379598983d2163deb13ba8ab13b14ba2c (diff) | |
| download | emacs-dacafa8c30cdae92f934512664fd2d322d91432b.tar.gz emacs-dacafa8c30cdae92f934512664fd2d322d91432b.zip | |
Ert commands to error if no test at point (bug#25931)
* lisp/emacs-lisp/ert.el (ert-results-mode-menu):
Deactivate some items if no test at point.
(ert--results-test-at-point-no-redefinition):
Add option to signal an error rather than return nil.
(ert-results-pop-to-backtrace-for-test-at-point)
(ert-results-pop-to-messages-for-test-at-point)
(ert-results-pop-to-should-forms-for-test-at-point)
(ert-results-describe-test-at-point): Error if no test at point.
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 57 |
1 files changed, 34 insertions, 23 deletions
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 785f4aca1cc..cadd66ca6ed 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el | |||
| @@ -2079,14 +2079,23 @@ and how to display message." | |||
| 2079 | '("ERT Results" | 2079 | '("ERT Results" |
| 2080 | ["Re-run all tests" ert-results-rerun-all-tests] | 2080 | ["Re-run all tests" ert-results-rerun-all-tests] |
| 2081 | "--" | 2081 | "--" |
| 2082 | ["Re-run test" ert-results-rerun-test-at-point] | 2082 | ;; FIXME? Why are there (at least) 3 different ways to decide if |
| 2083 | ["Debug test" ert-results-rerun-test-at-point-debugging-errors] | 2083 | ;; there is a test at point? |
| 2084 | ["Show test definition" ert-results-find-test-at-point-other-window] | 2084 | ["Re-run test" ert-results-rerun-test-at-point |
| 2085 | :active (car (ert--results-test-at-point-allow-redefinition))] | ||
| 2086 | ["Debug test" ert-results-rerun-test-at-point-debugging-errors | ||
| 2087 | :active (car (ert--results-test-at-point-allow-redefinition))] | ||
| 2088 | ["Show test definition" ert-results-find-test-at-point-other-window | ||
| 2089 | :active (ert-test-at-point)] | ||
| 2085 | "--" | 2090 | "--" |
| 2086 | ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point] | 2091 | ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point |
| 2087 | ["Show messages" ert-results-pop-to-messages-for-test-at-point] | 2092 | :active (ert--results-test-at-point-no-redefinition)] |
| 2088 | ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point] | 2093 | ["Show messages" ert-results-pop-to-messages-for-test-at-point |
| 2089 | ["Describe test" ert-results-describe-test-at-point] | 2094 | :active (ert--results-test-at-point-no-redefinition)] |
| 2095 | ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point | ||
| 2096 | :active (ert--results-test-at-point-no-redefinition)] | ||
| 2097 | ["Describe test" ert-results-describe-test-at-point | ||
| 2098 | :active (ert--results-test-at-point-no-redefinition)] | ||
| 2090 | "--" | 2099 | "--" |
| 2091 | ["Delete test" ert-delete-test] | 2100 | ["Delete test" ert-delete-test] |
| 2092 | "--" | 2101 | "--" |
| @@ -2237,22 +2246,24 @@ To be used in the ERT results buffer." | |||
| 2237 | (and (ert-test-boundp sym) | 2246 | (and (ert-test-boundp sym) |
| 2238 | sym)))) | 2247 | sym)))) |
| 2239 | 2248 | ||
| 2240 | (defun ert--results-test-at-point-no-redefinition () | 2249 | (defun ert--results-test-at-point-no-redefinition (&optional error) |
| 2241 | "Return the test at point, or nil. | 2250 | "Return the test at point, or nil. |
| 2242 | 2251 | If optional argument ERROR is non-nil, signal an error rather than return nil. | |
| 2243 | To be used in the ERT results buffer." | 2252 | To be used in the ERT results buffer." |
| 2244 | (cl-assert (eql major-mode 'ert-results-mode)) | 2253 | (cl-assert (eql major-mode 'ert-results-mode)) |
| 2245 | (if (ert--results-test-node-or-null-at-point) | 2254 | (or |
| 2246 | (let* ((node (ert--results-test-node-at-point)) | 2255 | (if (ert--results-test-node-or-null-at-point) |
| 2247 | (test (ert--ewoc-entry-test (ewoc-data node)))) | 2256 | (let* ((node (ert--results-test-node-at-point)) |
| 2248 | test) | 2257 | (test (ert--ewoc-entry-test (ewoc-data node)))) |
| 2249 | (let ((progress-bar-begin ert--results-progress-bar-button-begin)) | 2258 | test) |
| 2250 | (when (and (<= progress-bar-begin (point)) | 2259 | (let ((progress-bar-begin ert--results-progress-bar-button-begin)) |
| 2251 | (< (point) (button-end (button-at progress-bar-begin)))) | 2260 | (when (and (<= progress-bar-begin (point)) |
| 2252 | (let* ((test-index (- (point) progress-bar-begin)) | 2261 | (< (point) (button-end (button-at progress-bar-begin)))) |
| 2253 | (test (aref (ert--stats-tests ert--results-stats) | 2262 | (let* ((test-index (- (point) progress-bar-begin)) |
| 2263 | (test (aref (ert--stats-tests ert--results-stats) | ||
| 2254 | test-index))) | 2264 | test-index))) |
| 2255 | test))))) | 2265 | test)))) |
| 2266 | (if error (user-error "No test at point")))) | ||
| 2256 | 2267 | ||
| 2257 | (defun ert--results-test-at-point-allow-redefinition () | 2268 | (defun ert--results-test-at-point-allow-redefinition () |
| 2258 | "Look up the test at point, and check whether it has been redefined. | 2269 | "Look up the test at point, and check whether it has been redefined. |
| @@ -2377,7 +2388,7 @@ To be used in the ERT results buffer." | |||
| 2377 | 2388 | ||
| 2378 | To be used in the ERT results buffer." | 2389 | To be used in the ERT results buffer." |
| 2379 | (interactive) | 2390 | (interactive) |
| 2380 | (let* ((test (ert--results-test-at-point-no-redefinition)) | 2391 | (let* ((test (ert--results-test-at-point-no-redefinition t)) |
| 2381 | (stats ert--results-stats) | 2392 | (stats ert--results-stats) |
| 2382 | (pos (ert--stats-test-pos stats test)) | 2393 | (pos (ert--stats-test-pos stats test)) |
| 2383 | (result (aref (ert--stats-test-results stats) pos))) | 2394 | (result (aref (ert--stats-test-results stats) pos))) |
| @@ -2406,7 +2417,7 @@ To be used in the ERT results buffer." | |||
| 2406 | 2417 | ||
| 2407 | To be used in the ERT results buffer." | 2418 | To be used in the ERT results buffer." |
| 2408 | (interactive) | 2419 | (interactive) |
| 2409 | (let* ((test (ert--results-test-at-point-no-redefinition)) | 2420 | (let* ((test (ert--results-test-at-point-no-redefinition t)) |
| 2410 | (stats ert--results-stats) | 2421 | (stats ert--results-stats) |
| 2411 | (pos (ert--stats-test-pos stats test)) | 2422 | (pos (ert--stats-test-pos stats test)) |
| 2412 | (result (aref (ert--stats-test-results stats) pos))) | 2423 | (result (aref (ert--stats-test-results stats) pos))) |
| @@ -2427,7 +2438,7 @@ To be used in the ERT results buffer." | |||
| 2427 | 2438 | ||
| 2428 | To be used in the ERT results buffer." | 2439 | To be used in the ERT results buffer." |
| 2429 | (interactive) | 2440 | (interactive) |
| 2430 | (let* ((test (ert--results-test-at-point-no-redefinition)) | 2441 | (let* ((test (ert--results-test-at-point-no-redefinition t)) |
| 2431 | (stats ert--results-stats) | 2442 | (stats ert--results-stats) |
| 2432 | (pos (ert--stats-test-pos stats test)) | 2443 | (pos (ert--stats-test-pos stats test)) |
| 2433 | (result (aref (ert--stats-test-results stats) pos))) | 2444 | (result (aref (ert--stats-test-results stats) pos))) |
| @@ -2554,7 +2565,7 @@ To be used in the ERT results buffer." | |||
| 2554 | 2565 | ||
| 2555 | To be used in the ERT results buffer." | 2566 | To be used in the ERT results buffer." |
| 2556 | (interactive) | 2567 | (interactive) |
| 2557 | (ert-describe-test (ert--results-test-at-point-no-redefinition))) | 2568 | (ert-describe-test (ert--results-test-at-point-no-redefinition t))) |
| 2558 | 2569 | ||
| 2559 | 2570 | ||
| 2560 | ;;; Actions on load/unload. | 2571 | ;;; Actions on load/unload. |