emacs-orgmode
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[O] [PATCH] When testing, fake the current time more robustly


From: Paul Eggert
Subject: [O] [PATCH] When testing, fake the current time more robustly
Date: Tue, 12 Feb 2019 14:44:23 -0800

The old approach required Lisp code to use (current-time)
explicitly when calling other primitives, e.g., (float-time
(current-time)).  The new approach fakes all the primitives,
so that Lisp code can now use expressions like plain (float-time).
* testing/org-test.el (org-test-at-time): New macro.
* testing/lisp/test-org-colview.el (test-org-colview/columns-summary):
* testing/lisp/test-org-timer.el (test-org-timer/with-current-time):
* testing/lisp/test-org.el (test-org/org-read-date)
(test-org/deadline-close-p, test-org/deadline)
(test-org/schedule, test-org/time-stamp):
Use it.
---
 testing/lisp/test-org-colview.el | 15 ++-------
 testing/lisp/test-org-timer.el   |  3 +-
 testing/lisp/test-org.el         | 57 ++++++++------------------------
 testing/org-test.el              | 52 +++++++++++++++++++++++++++++
 4 files changed, 69 insertions(+), 58 deletions(-)

diff --git a/testing/lisp/test-org-colview.el b/testing/lisp/test-org-colview.el
index 532515b53..ed75090df 100644
--- a/testing/lisp/test-org-colview.el
+++ b/testing/lisp/test-org-colview.el
@@ -510,10 +510,7 @@
   (should
    (equal
     "0min"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time
-                       (org-parse-time-string "<2014-03-04 Tue>")))))
+    (org-test-at-time "<2014-03-04 Tue>"
       (org-test-with-temp-text
          "* H
 ** S1
@@ -529,10 +526,7 @@
   (should
    (equal
     "2d"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time
-                       (org-parse-time-string "<2014-03-04 Tue>")))))
+    (org-test-at-time "<2014-03-04 Tue>"
       (org-test-with-temp-text
          "* H
 ** S1
@@ -548,10 +542,7 @@
   (should
    (equal
     "1d 12h"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time
-                       (org-parse-time-string "<2014-03-04 Tue>")))))
+    (org-test-at-time "<2014-03-04 Tue>"
       (org-test-with-temp-text
          "* H
 ** S1
diff --git a/testing/lisp/test-org-timer.el b/testing/lisp/test-org-timer.el
index f6bd5ab1a..27156dfa9 100644
--- a/testing/lisp/test-org-timer.el
+++ b/testing/lisp/test-org-timer.el
@@ -40,8 +40,7 @@ Also, mute output from `message'."
 (defmacro test-org-timer/with-current-time (time &rest body)
   "Run BODY, setting `current-time' output to TIME."
   (declare (indent 1))
-  `(cl-letf (((symbol-function 'current-time) (lambda () ,time)))
-     ,@body))
+  `(org-test-at-time ,time ,@body))
 
 
 ;;; Time conversion and formatting
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index feaacf673..c3bd07923 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -198,18 +198,14 @@
   (should
    (equal
     "2015-03-04"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2014-03-04")))))
+    (org-test-at-time "2014-03-04"
       (org-read-date
        t nil "+1y" nil
        (apply #'encode-time (org-parse-time-string "2012-03-29"))))))
   (should
    (equal
     "2013-03-29"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2014-03-04")))))
+    (org-test-at-time "2014-03-04"
       (org-read-date
        t nil "++1y" nil
        (apply #'encode-time (org-parse-time-string "2012-03-29"))))))
@@ -219,25 +215,19 @@
   (should
    (equal
     "2014-04-01"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2014-03-04")))))
+    (org-test-at-time "2014-03-04"
       (let ((org-read-date-prefer-future t))
        (org-read-date t nil "1")))))
   (should
    (equal
     "2013-03-04"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2012-03-29")))))
+    (org-test-at-time "2012-03-29"
       (let ((org-read-date-prefer-future t))
        (org-read-date t nil "3-4")))))
   (should
    (equal
     "2012-03-04"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2012-03-29")))))
+    (org-test-at-time "2012-03-29"
       (let ((org-read-date-prefer-future nil))
        (org-read-date t nil "3-4")))))
   ;; When set to `org-read-date-prefer-future' is set to `time', read
@@ -247,17 +237,13 @@
   (should
    (equal
     "2012-03-30"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2012-03-29 
16:40")))))
+    (org-test-at-time "2012-03-29 16:40"
       (let ((org-read-date-prefer-future 'time))
        (org-read-date t nil "00:40" nil)))))
   (should-not
    (equal
     "2012-03-30"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2012-03-29 
16:40")))))
+    (org-test-at-time "2012-03-29 16:40"
       (let ((org-read-date-prefer-future 'time))
        (org-read-date t nil "29 00:40" nil)))))
   ;; Caveat: `org-read-date-prefer-future' always refers to current
@@ -265,9 +251,7 @@
   (should
    (equal
     "2014-04-01"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2014-03-04")))))
+    (org-test-at-time "2014-03-04"
       (let ((org-read-date-prefer-future t))
        (org-read-date
         t nil "1" nil
@@ -275,9 +259,7 @@
   (should
    (equal
     "2014-03-25"
-    (cl-letf (((symbol-function 'current-time)
-              (lambda ()
-                (apply #'encode-time (org-parse-time-string "2014-03-04")))))
+    (org-test-at-time "2014-03-04"
       (let ((org-read-date-prefer-future t))
        (org-read-date
         t nil "25" nil
@@ -376,11 +358,7 @@
 
 (ert-deftest test-org/deadline-close-p ()
   "Test `org-deadline-close-p' specifications."
-  ;; Pretend that the current time is 2016-06-03 Fri 01:43
-  (cl-letf (((symbol-function 'current-time)
-            (lambda ()
-              (apply #'encode-time
-                     (org-parse-time-string "2016-06-03 Fri 01:43")))))
+  (org-test-at-time "2016-06-03 Fri 01:43"
     ;; Timestamps are close if they are within `ndays' of lead time.
     (org-test-with-temp-text "* Heading"
       (should (org-deadline-close-p "2016-06-03 Fri" 0))
@@ -4859,10 +4837,7 @@ Paragraph<point>"
   ;; Accept delta time, e.g., "+2d".
   (should
    (equal "* H\nDEADLINE: <2015-03-04>\n"
-         (cl-letf (((symbol-function 'current-time)
-                    (lambda (&rest args)
-                      (apply #'encode-time
-                             (org-parse-time-string "2014-03-04")))))
+         (org-test-at-time "2014-03-04"
            (org-test-with-temp-text "* H"
              (let ((org-adapt-indentation nil)
                    (org-last-inserted-timestamp nil))
@@ -4976,10 +4951,7 @@ Paragraph<point>"
   ;; Accept delta time, e.g., "+2d".
   (should
    (equal "* H\nSCHEDULED: <2015-03-04>\n"
-         (cl-letf (((symbol-function 'current-time)
-                    (lambda (&rest args)
-                      (apply #'encode-time
-                             (org-parse-time-string "2014-03-04")))))
+         (org-test-at-time "2014-03-04"
            (org-test-with-temp-text "* H"
              (let ((org-adapt-indentation nil)
                    (org-last-inserted-timestamp nil))
@@ -6871,10 +6843,7 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 
 6:40"
    (string-match
     "Te<2014-03-04 .*? 00:41>xt"
     (org-test-with-temp-text "Te<point>xt"
-      (cl-letf (((symbol-function 'current-time)
-                (lambda ()
-                  (apply #'encode-time
-                         (org-parse-time-string "2014-03-04 00:41")))))
+      (org-test-at-time "2014-03-04 00:41"
        (org-time-stamp '(16))
        (buffer-string)))))
   ;; When optional argument is non-nil, insert an inactive timestamp.
diff --git a/testing/org-test.el b/testing/org-test.el
index 8bf75b421..39c346410 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -418,6 +418,58 @@ Load all test files first."
   (ert "\\(org\\|ob\\)")
   (org-test-kill-all-examples))
 
+(defmacro org-test-at-time (time &rest body)
+  "Run body while pretending that the current time is TIME.
+TIME can be a non-nil Lisp time value, or a string specifying a date and time."
+  (declare (indent 1))
+  (let ((tm (cl-gensym))
+       (at (cl-gensym)))
+    `(let* ((,tm ,time)
+           (,at (if (stringp ,tm)
+                    (apply #'encode-time (org-parse-time-string ,tm))
+                  ,tm)))
+       (cl-letf
+          ;; Wrap builtins whose behavior can depend on the current time.
+          (((symbol-function 'current-time)
+            (lambda () ,at))
+           ((symbol-function 'current-time-string)
+            (lambda (&optional time &rest args)
+              (apply ,(symbol-function 'current-time-string)
+                     (or time ,at) args)))
+           ((symbol-function 'current-time-zone)
+            (lambda (&optional time &rest args)
+              (apply ,(symbol-function 'current-time-zone)
+                     (or time ,at) args)))
+           ((symbol-function 'decode-time)
+            (lambda (&optional time) (funcall ,(symbol-function 'decode-time)
+                                              (or time ,at))))
+           ((symbol-function 'encode-time)
+            (lambda (time &rest args)
+              (apply ,(symbol-function 'encode-time) (or time ,at) args)))
+           ((symbol-function 'float-time)
+            (lambda (&optional time)
+              (funcall ,(symbol-function 'float-time) (or time ,at))))
+           ((symbol-function 'format-time-string)
+            (lambda (format &optional time &rest args)
+              (apply ,(symbol-function 'format-time-string)
+                     format (or time ,at) args)))
+           ((symbol-function 'set-file-times)
+            (lambda (file &optional time)
+              (funcall ,(symbol-function 'set-file-times) file (or time ,at))))
+           ((symbol-function 'time-add)
+            (lambda (a b) (funcall ,(symbol-function 'time-add)
+                                   (or a ,at) (or b ,at))))
+           ((symbol-function 'time-equal-p)
+            (lambda (a b) (funcall ,(symbol-function 'time-equal-p)
+                                   (or a ,at) (or b ,at))))
+           ((symbol-function 'time-less-p)
+            (lambda (a b) (funcall ,(symbol-function 'time-less-p)
+                                   (or a ,at) (or b ,at))))
+           ((symbol-function 'time-subtract)
+            (lambda (a b) (funcall ,(symbol-function 'time-subtract)
+                                   (or a ,at) (or b ,at)))))
+        ,@body))))
+
 (provide 'org-test)
 
 ;;; org-test.el ends here
-- 
2.20.1




reply via email to

[Prev in Thread] Current Thread [Next in Thread]