From mboxrd@z Thu Jan 1 00:00:00 1970 From: Paul Eggert Subject: [PATCH] When testing, fake the current time more robustly Date: Tue, 12 Feb 2019 14:44:23 -0800 Message-ID: <20190212224423.3388-1-eggert@cs.ucla.edu> Mime-Version: 1.0 Content-Transfer-Encoding: quoted-printable Return-path: Received: from eggs.gnu.org ([209.51.188.92]:57223) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gth1M-000899-9Q for Emacs-orgmode@gnu.org; Tue, 12 Feb 2019 17:59:21 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gtgn4-0008AE-E2 for Emacs-orgmode@gnu.org; Tue, 12 Feb 2019 17:44:36 -0500 Received: from zimbra.cs.ucla.edu ([131.179.128.68]:50658) by eggs.gnu.org with esmtps (TLS1.0:DHE_RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1gtgn2-00086V-NL for Emacs-orgmode@gnu.org; Tue, 12 Feb 2019 17:44:32 -0500 Received: from localhost (localhost [127.0.0.1]) by zimbra.cs.ucla.edu (Postfix) with ESMTP id 5206816130C for ; Tue, 12 Feb 2019 14:44:29 -0800 (PST) List-Id: "General discussions about Org-mode." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-orgmode-bounces+geo-emacs-orgmode=m.gmane.org@gnu.org Sender: "Emacs-orgmode" To: Emacs-orgmode@gnu.org Cc: Paul Eggert 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-col= view.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)) =20 =0C ;;; 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 @@ =20 (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" ;; 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" ;; 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] =3D> 6:40" (string-match "Te<2014-03-04 .*? 00:41>xt" (org-test-with-temp-text "Text" - (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)) =20 +(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) =20 ;;; org-test.el ends here --=20 2.20.1