From 8be7e98557df8ba708b3f7e285a29f279b609e46 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 25 Mar 2025 00:12:20 +0100 Subject: [PATCH] Add an ERT explainer for 'time-equal-p'. * lisp/emacs-lisp/ert.el (ert--explain-time-equal-p): New explainer function. * test/lisp/emacs-lisp/ert-tests.el (ert-test-explain-time-equal-p): New test. --- lisp/emacs-lisp/ert.el | 13 +++++++++++++ test/lisp/emacs-lisp/ert-tests.el | 8 ++++++++ 2 files changed, 21 insertions(+) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index c8cee72025f..ef00dc73f91 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -669,6 +669,19 @@ Return nil if they are." (put 'equal-including-properties 'ert-explainer 'ert--explain-equal-including-properties) +(defun ert--explain-time-equal-p (a b) + "Explainer function for `time-equal-p'. +A and B are the time values to compare." + (declare (ftype (function (t t) list)) + (side-effect-free t)) + (unless (time-equal-p a b) + `(different-time-values + ,(format-time-string "%F %T.%N %Z" a t) + ,(format-time-string "%F %T.%N %Z" b t) + difference + ,(format-time-string "%s.%N" (time-subtract a b) t)))) +(function-put #'time-equal-p 'ert-explainer #'ert--explain-time-equal-p) + ;;; Implementation of `ert-info'. ;; TODO(ohler): The name `info' clashes with diff --git a/test/lisp/emacs-lisp/ert-tests.el b/test/lisp/emacs-lisp/ert-tests.el index aec2c92ba81..7a08cb47d82 100644 --- a/test/lisp/emacs-lisp/ert-tests.el +++ b/test/lisp/emacs-lisp/ert-tests.el @@ -792,6 +792,14 @@ This macro is used to test if macroexpansion in `should' works." '(char 1 "o" (different-properties-for-key a (different-atoms b foo)) context-before "f" context-after "o")))) +(ert-deftest ert-test-explain-time-equal-p () + (should-not (ert--explain-time-equal-p 123 '(0 123 0 0))) + (should (equal (ert--explain-time-equal-p 123 '(0 120 0 0)) + '(different-time-values + "1970-01-01 00:02:03.000000000 UTC" + "1970-01-01 00:02:00.000000000 UTC" + difference "3.000000000")))) + (ert-deftest ert-test-stats-set-test-and-result () (let* ((test-1 (make-ert-test :name 'test-1 :body (lambda () nil)))