mirrors
/
org-mode
mirror of https://git.savannah.gnu.org/git/emacs/org-mode.git
0
0
Fork 1
Code Releases Activity

When testing, fake the current time more robustly 

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.
This commit is contained in:
Paul Eggert 2019-02-12 14:44:23 -08:00 committed by Kyle Meyer
parent e54f09af50
commit 2cd1f9b028
4 changed files with 69 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
testing/lisp/test-org-colview.el
View File

@ -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

3
testing/lisp/test-org-timer.el
View File

@ -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

57
testing/lisp/test-org.el
View File

@ -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))
@ -4847,10 +4825,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))
@ -4964,10 +4939,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))
@ -6859,10 +6831,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.

52
testing/org-test.el
View File

@ -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