diff options
Diffstat (limited to 'lisp/emacs-lisp/ert.el')
| -rw-r--r-- | lisp/emacs-lisp/ert.el | 100 |
1 files changed, 50 insertions, 50 deletions
diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 02551bad31f..178a29d073b 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -328,8 +328,8 @@ DATA is displayed to the user and should state the reason for skipping." (unless (eql ,value ',default-value) (list :value ,value)) (unless (eql ,value ',default-value) - (when-let ((-explainer- - (ert--get-explainer ',fn-name))) + (when-let* ((-explainer- + (ert--get-explainer ',fn-name))) (list :explanation (apply -explainer- ,args))))) value) @@ -576,7 +576,7 @@ Return nil if they are." (defun ert--significant-plist-keys (plist) "Return the keys of PLIST that have non-null values, in order." - (cl-assert (zerop (mod (length plist) 2)) t) + (cl-assert (evenp (length plist)) t) (cl-loop for (key value . rest) on plist by #'cddr unless (or (null value) (memq key accu)) collect key into accu finally (cl-return accu))) @@ -587,8 +587,8 @@ Return nil if they are." Returns nil if they are equivalent, i.e., have the same value for each key, where absent values are treated as nil. The order of key/value pairs in each list does not matter." - (cl-assert (zerop (mod (length a) 2)) t) - (cl-assert (zerop (mod (length b) 2)) t) + (cl-assert (evenp (length a)) t) + (cl-assert (evenp (length b)) t) ;; Normalizing the plists would be another way to do this but it ;; requires a total ordering on all lisp objects (since any object ;; is valid as a text property key). Perhaps defining such an @@ -1159,21 +1159,21 @@ Also changes the counters in STATS to match." (aref results pos)) (cl-etypecase (aref results pos) (ert-test-passed - (cl-incf (ert--stats-passed-expected stats) d)) + (incf (ert--stats-passed-expected stats) d)) (ert-test-failed - (cl-incf (ert--stats-failed-expected stats) d)) + (incf (ert--stats-failed-expected stats) d)) (ert-test-skipped - (cl-incf (ert--stats-skipped stats) d)) + (incf (ert--stats-skipped stats) d)) (null) (ert-test-aborted-with-non-local-exit) (ert-test-quit)) (cl-etypecase (aref results pos) (ert-test-passed - (cl-incf (ert--stats-passed-unexpected stats) d)) + (incf (ert--stats-passed-unexpected stats) d)) (ert-test-failed - (cl-incf (ert--stats-failed-unexpected stats) d)) + (incf (ert--stats-failed-unexpected stats) d)) (ert-test-skipped - (cl-incf (ert--stats-skipped stats) d)) + (incf (ert--stats-skipped stats) d)) (null) (ert-test-aborted-with-non-local-exit) (ert-test-quit))))) @@ -1316,13 +1316,9 @@ empty string." (defun ert--pp-with-indentation-and-newline (object) "Pretty-print OBJECT, indenting it to the current column of point. Ensures a final newline is inserted." - (let ((begin (point)) - (cols (current-column)) - (pp-escape-newlines t) + (let ((pp-escape-newlines t) (print-escape-control-characters t)) - (pp object (current-buffer)) - (unless (bolp) (insert "\n")) - (indent-rigidly begin (point) cols))) + (pp object (current-buffer)))) (defun ert--insert-infos (result) "Insert `ert-info' infos from RESULT into current buffer. @@ -1356,10 +1352,10 @@ RESULT must be an `ert-test-result-with-condition'." (defun ert-test-location (test) "Return a string description the source location of TEST." - (when-let ((loc - (ignore-errors - (find-function-search-for-symbol - (ert-test-name test) 'ert-deftest (ert-test-file-name test))))) + (when-let* ((loc + (ignore-errors + (find-function-search-for-symbol + (ert-test-name test) 'ert--test (ert-test-file-name test))))) (let* ((buffer (car loc)) (point (cdr loc)) (file (file-relative-name (buffer-file-name buffer))) @@ -1423,7 +1419,7 @@ Returns the stats object." (message "%9s %S%s" (ert-string-for-test-result result nil) (ert-test-name test) - (if (cl-plusp + (if (plusp (length (getenv "EMACS_TEST_VERBOSE"))) (ert-reason-for-test-result result) "")))) @@ -1436,7 +1432,7 @@ Returns the stats object." (message "%9s %S%s" (ert-string-for-test-result result nil) (ert-test-name test) - (if (cl-plusp + (if (plusp (length (getenv "EMACS_TEST_VERBOSE"))) (ert-reason-for-test-result result) "")))) @@ -1552,11 +1548,11 @@ test packages depend on each other, it might be helpful.") "Write a JUnit test report, generated from STATS." ;; https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format ;; https://llg.cubic.org/docs/junit/ - (when-let ((symbol (car (apropos-internal "" #'ert-test-boundp))) - (test-file (symbol-file symbol 'ert--test)) - (test-report - (file-name-with-extension - (or ert-load-file-name test-file) "xml"))) + (when-let* ((symbol (car (apropos-internal "" #'ert-test-boundp))) + (test-file (symbol-file symbol 'ert--test)) + (test-report + (file-name-with-extension + (or ert-load-file-name test-file) "xml"))) (with-temp-file test-report (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n") (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n" @@ -1688,8 +1684,8 @@ test packages depend on each other, it might be helpful.") (insert " </error>\n" " </testcase>\n" " </testsuite>\n") - (cl-incf errors 1) - (cl-incf id 1))) + (incf errors 1) + (incf id 1))) (insert-file-contents-literally test-report) (when (looking-at-p @@ -1697,15 +1693,15 @@ test packages depend on each other, it might be helpful.") (delete-region (point) (line-beginning-position 2))) (when (looking-at "<testsuites name=\".+\" tests=\"\\(.+\\)\" errors=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">") - (cl-incf tests (string-to-number (match-string 1))) - (cl-incf errors (string-to-number (match-string 2))) - (cl-incf failures (string-to-number (match-string 3))) - (cl-incf skipped (string-to-number (match-string 4))) - (cl-incf time (string-to-number (match-string 5))) + (incf tests (string-to-number (match-string 1))) + (incf errors (string-to-number (match-string 2))) + (incf failures (string-to-number (match-string 3))) + (incf skipped (string-to-number (match-string 4))) + (incf time (string-to-number (match-string 5))) (delete-region (point) (line-beginning-position 2))) (when (looking-at " <testsuite id=\"\\(0\\)\"") (replace-match (number-to-string id) nil nil nil 1) - (cl-incf id 1)) + (incf id 1)) (goto-char (point-max)) (beginning-of-line 0) (when (looking-at-p "</testsuites>") @@ -2127,7 +2123,7 @@ non-nil, returns the face for expected results.." (defun ert-face-for-stats (stats) "Return a face that represents STATS." (cond ((ert--stats-aborted-p stats) 'nil) - ((cl-plusp (ert-stats-completed-unexpected stats)) + ((plusp (ert-stats-completed-unexpected stats)) (ert-face-for-test-result nil)) ((eql (ert-stats-completed-expected stats) (ert-stats-total stats)) (ert-face-for-test-result t)) @@ -2471,7 +2467,9 @@ To be used in the ERT results buffer." (defun ert--test-name-button-action (button) "Find the definition of the test BUTTON belongs to, in another window." - (let ((name (button-get button 'ert-test-name))) + ;; work with either ert-insert-test-name-button or help-xref-button + (let ((name (or (button-get button 'ert-test-name) + (car (button-get button 'help-args))))) (ert-find-test-other-window name))) (defun ert--ewoc-position (ewoc node) @@ -2818,7 +2816,8 @@ To be used in the ERT results buffer." (file-name-nondirectory file-name))) (save-excursion (re-search-backward (substitute-command-keys "`\\([^`']+\\)'")) - (help-xref-button 1 'help-function-def test-name file-name))) + (help-xref-button 1 'ert--test-name-button + test-name file-name))) (insert ".") (fill-region-as-paragraph (point-min) (point)) (insert "\n\n") @@ -2857,14 +2856,16 @@ To be used in the ERT results buffer." (ert--tests-running-mode-line-indicator)))) (add-hook 'emacs-lisp-mode-hook #'ert--activate-font-lock-keywords) -(defun ert--unload-function () +(defun ert-unload-function () "Unload function to undo the side-effects of loading ert.el." - (ert--remove-from-list 'find-function-regexp-alist 'ert-deftest :key #'car) + (ert--remove-from-list 'find-function-regexp-alist 'ert--test :key #'car) (ert--remove-from-list 'minor-mode-alist 'ert--current-run-stats :key #'car) (ert--remove-from-list 'emacs-lisp-mode-hook 'ert--activate-font-lock-keywords) nil) +;;; erts files. + (defun ert-test-erts-file (file &optional transform) "Parse FILE as a file containing before/after parts (an erts file). @@ -2910,10 +2911,10 @@ write erts files." (setq end-before end-after start-after start-before)) ;; Update persistent specs. - (when-let ((point-char (assq 'point-char specs))) + (when-let* ((point-char (assq 'point-char specs))) (setq gen-specs (map-insert gen-specs 'point-char (cdr point-char)))) - (when-let ((code (cdr (assq 'code specs)))) + (when-let* ((code (cdr (assq 'code specs)))) (setq gen-specs (map-insert gen-specs 'code (car (read-from-string code))))) ;; Get the "after" strings. @@ -2921,12 +2922,12 @@ write erts files." (insert-buffer-substring file-buffer start-after end-after) (ert--erts-unquote) ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-after-newline specs)))) + (when-let* ((no-newline (cdr (assq 'no-after-newline specs)))) (goto-char (point-min)) (when (re-search-forward "\n\\'" nil t) (delete-region (match-beginning 0) (match-end 0)))) ;; Get the expected "after" point. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when-let* ((point-char (cdr (assq 'point-char gen-specs)))) (goto-char (point-min)) (when (search-forward point-char nil t) (delete-region (match-beginning 0) (match-end 0)) @@ -2937,13 +2938,13 @@ write erts files." (insert-buffer-substring file-buffer start-before end-before) (ert--erts-unquote) ;; Remove the newline at the end of the buffer. - (when-let ((no-newline (cdr (assq 'no-before-newline specs)))) + (when-let* ((no-newline (cdr (assq 'no-before-newline specs)))) (goto-char (point-min)) (when (re-search-forward "\n\\'" nil t) (delete-region (match-beginning 0) (match-end 0)))) (goto-char (point-min)) ;; Place point in the specified place. - (when-let ((point-char (cdr (assq 'point-char gen-specs)))) + (when-let* ((point-char (cdr (assq 'point-char gen-specs)))) (when (search-forward point-char nil t) (delete-region (match-beginning 0) (match-end 0)))) (let ((code (cdr (assq 'code gen-specs)))) @@ -2991,9 +2992,6 @@ write erts files." (forward-line 1))) (nreverse specs)))) -(defvar ert-unload-hook ()) -(add-hook 'ert-unload-hook #'ert--unload-function) - ;;; Obsolete (define-obsolete-function-alias 'ert-equal-including-properties @@ -3001,6 +2999,8 @@ write erts files." (put 'ert-equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) +(define-obsolete-function-alias 'ert--unload-function 'ert-unload-function "31.1") + (provide 'ert) ;;; ert.el ends here |