diff options
Diffstat (limited to 'lisp/emacs-lisp/ert.el')
-rw-r--r-- | lisp/emacs-lisp/ert.el | 99 |
1 files changed, 66 insertions, 33 deletions
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 60916f4bed5..cadd66ca6ed 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -276,11 +276,12 @@ DATA is displayed to the user and should state the reason for skipping." (defun ert--expand-should-1 (whole form inner-expander) "Helper function for the `should' macro and its variants." (let ((form - (macroexpand form (cond - ((boundp 'macroexpand-all-environment) - macroexpand-all-environment) - ((boundp 'cl-macro-environment) - cl-macro-environment))))) + (macroexpand form (append byte-compile-macro-environment + (cond + ((boundp 'macroexpand-all-environment) + macroexpand-all-environment) + ((boundp 'cl-macro-environment) + cl-macro-environment)))))) (cond ((or (atom form) (ert--special-operator-p (car form))) (let ((value (cl-gensym "value-"))) @@ -1470,7 +1471,7 @@ this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." (user-error "This function is only for use in batch mode")) (let ((nlogs (length command-line-args-left)) (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) - nnotrun logfile notests badtests unexpected) + nnotrun logfile notests badtests unexpected skipped) (with-temp-buffer (while (setq logfile (pop command-line-args-left)) (erase-buffer) @@ -1490,9 +1491,10 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (push logfile unexpected) (setq nunexpected (+ nunexpected (string-to-number (match-string 4))))) - (if (match-string 5) - (setq nskipped (+ nskipped - (string-to-number (match-string 5))))))))) + (when (match-string 5) + (push logfile skipped) + (setq nskipped (+ nskipped + (string-to-number (match-string 5))))))))) (setq nnotrun (- ntests nrun)) (message "\nSUMMARY OF TEST RESULTS") (message "-----------------------") @@ -1516,6 +1518,26 @@ Ran \\([0-9]+\\) tests, \\([0-9]+\\) results as expected\ (when unexpected (message "%d files contained unexpected results:" (length unexpected)) (mapc (lambda (l) (message " %s" l)) unexpected)) + ;; More details on hydra, where the logs are harder to get to. + (when (and (getenv "NIX_STORE") + (not (zerop (+ nunexpected nskipped)))) + (message "\nDETAILS") + (message "-------") + (with-temp-buffer + (dolist (x (list (list skipped "skipped" "SKIPPED") + (list unexpected "unexpected" "FAILED"))) + (mapc (lambda (l) + (erase-buffer) + (insert-file-contents l) + (message "%s:" l) + (when (re-search-forward (format "^[ \t]*[0-9]+ %s results:" + (nth 1 x)) + nil t) + (while (and (zerop (forward-line 1)) + (looking-at (format "^[ \t]*%s" (nth 2 x)))) + (message "%s" (buffer-substring (line-beginning-position) + (line-end-position)))))) + (car x))))) (kill-emacs (cond ((or notests badtests (not (zerop nnotrun))) 2) (unexpected 1) (t 0))))) @@ -2057,14 +2079,23 @@ and how to display message." '("ERT Results" ["Re-run all tests" ert-results-rerun-all-tests] "--" - ["Re-run test" ert-results-rerun-test-at-point] - ["Debug test" ert-results-rerun-test-at-point-debugging-errors] - ["Show test definition" ert-results-find-test-at-point-other-window] + ;; FIXME? Why are there (at least) 3 different ways to decide if + ;; there is a test at point? + ["Re-run test" ert-results-rerun-test-at-point + :active (car (ert--results-test-at-point-allow-redefinition))] + ["Debug test" ert-results-rerun-test-at-point-debugging-errors + :active (car (ert--results-test-at-point-allow-redefinition))] + ["Show test definition" ert-results-find-test-at-point-other-window + :active (ert-test-at-point)] "--" - ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point] - ["Show messages" ert-results-pop-to-messages-for-test-at-point] - ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point] - ["Describe test" ert-results-describe-test-at-point] + ["Show backtrace" ert-results-pop-to-backtrace-for-test-at-point + :active (ert--results-test-at-point-no-redefinition)] + ["Show messages" ert-results-pop-to-messages-for-test-at-point + :active (ert--results-test-at-point-no-redefinition)] + ["Show `should' forms" ert-results-pop-to-should-forms-for-test-at-point + :active (ert--results-test-at-point-no-redefinition)] + ["Describe test" ert-results-describe-test-at-point + :active (ert--results-test-at-point-no-redefinition)] "--" ["Delete test" ert-delete-test] "--" @@ -2215,22 +2246,24 @@ To be used in the ERT results buffer." (and (ert-test-boundp sym) sym)))) -(defun ert--results-test-at-point-no-redefinition () +(defun ert--results-test-at-point-no-redefinition (&optional error) "Return the test at point, or nil. - +If optional argument ERROR is non-nil, signal an error rather than return nil. To be used in the ERT results buffer." (cl-assert (eql major-mode 'ert-results-mode)) - (if (ert--results-test-node-or-null-at-point) - (let* ((node (ert--results-test-node-at-point)) - (test (ert--ewoc-entry-test (ewoc-data node)))) - test) - (let ((progress-bar-begin ert--results-progress-bar-button-begin)) - (when (and (<= progress-bar-begin (point)) - (< (point) (button-end (button-at progress-bar-begin)))) - (let* ((test-index (- (point) progress-bar-begin)) - (test (aref (ert--stats-tests ert--results-stats) + (or + (if (ert--results-test-node-or-null-at-point) + (let* ((node (ert--results-test-node-at-point)) + (test (ert--ewoc-entry-test (ewoc-data node)))) + test) + (let ((progress-bar-begin ert--results-progress-bar-button-begin)) + (when (and (<= progress-bar-begin (point)) + (< (point) (button-end (button-at progress-bar-begin)))) + (let* ((test-index (- (point) progress-bar-begin)) + (test (aref (ert--stats-tests ert--results-stats) test-index))) - test))))) + test)))) + (if error (user-error "No test at point")))) (defun ert--results-test-at-point-allow-redefinition () "Look up the test at point, and check whether it has been redefined. @@ -2355,7 +2388,7 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) - (let* ((test (ert--results-test-at-point-no-redefinition)) + (let* ((test (ert--results-test-at-point-no-redefinition t)) (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) @@ -2384,7 +2417,7 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) - (let* ((test (ert--results-test-at-point-no-redefinition)) + (let* ((test (ert--results-test-at-point-no-redefinition t)) (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) @@ -2405,7 +2438,7 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) - (let* ((test (ert--results-test-at-point-no-redefinition)) + (let* ((test (ert--results-test-at-point-no-redefinition t)) (stats ert--results-stats) (pos (ert--stats-test-pos stats test)) (result (aref (ert--stats-test-results stats) pos))) @@ -2460,7 +2493,7 @@ To be used in the ERT results buffer." stats) for end-time across (ert--stats-test-end-times stats) collect (list test - (float-time (subtract-time + (float-time (time-subtract end-time start-time)))))) (setq data (sort data (lambda (a b) (> (cl-second a) (cl-second b))))) @@ -2532,7 +2565,7 @@ To be used in the ERT results buffer." To be used in the ERT results buffer." (interactive) - (ert-describe-test (ert--results-test-at-point-no-redefinition))) + (ert-describe-test (ert--results-test-at-point-no-redefinition t))) ;;; Actions on load/unload. |