Merge branch 'maint'

lisp/org-colview.el

@@ -1208,10 +1208,7 @@ column specification."
   "Compute all columns that have operators defined."
   (with-silent-modifications
     (remove-text-properties (point-min) (point-max) '(org-summaries t)))
-  ;; Pass `current-time' result to `float-time' (instead of calling
-  ;; without arguments) so that only `current-time' has to be
-  ;; overridden in tests.
-  (let ((org-columns--time (float-time (current-time)))
+  (let ((org-columns--time (float-time))
 	seen)
     (dolist (spec org-columns-current-fmt-compiled)
       (let ((property (car spec)))

lisp/org-timer.el

@@ -141,10 +141,7 @@ the region 0:00:00."
 	  (setq delta (org-timer-hms-to-secs (org-timer-fix-incomplete s)))))
 	(setq org-timer-start-time
 	      (seconds-to-time
-	       ;; Pass `current-time' result to `float-time' (instead
-	       ;; of calling without arguments) so that only
-	       ;; `current-time' has to be overridden in tests.
-	       (- (float-time (current-time)) delta))))
+	       (- (float-time) delta))))
       (setq org-timer-pause-time nil)
       (org-timer-set-mode-line 'on)
       (message "Timer start time set to %s, current value is %s"
@@ -174,7 +171,7 @@ With prefix arg STOP, stop it entirely."
 	    (setq org-timer-start-time
 		  (time-add (current-time) (seconds-to-time new-secs))))
 	(setq org-timer-start-time
-	      (seconds-to-time (- (float-time (current-time))
+	      (seconds-to-time (- (float-time)
 				  (- pause-secs start-secs)))))
       (setq org-timer-pause-time nil)
       (org-timer-set-mode-line 'on)
@@ -235,14 +232,9 @@ it in the buffer."
 	   (abs (floor (org-timer-seconds))))))
 
 (defun org-timer-seconds ()
-  ;; Pass `current-time' result to `float-time' (instead of calling
-  ;; without arguments) so that only `current-time' has to be
-  ;; overridden in tests.
-  (if org-timer-countdown-timer
-      (- (float-time org-timer-start-time)
-	 (float-time (or org-timer-pause-time (current-time))))
-    (- (float-time (or org-timer-pause-time (current-time)))
-       (float-time org-timer-start-time))))
+  (funcall (if org-timer-countdown-timer #'+ #'-)
+	   (- (float-time org-timer-start-time)
+	      (float-time org-timer-pause-time))))
 
 ;;;###autoload
 (defun org-timer-change-times-in-region (beg end delta)
@@ -467,8 +459,8 @@ using three `C-u' prefix arguments."
 		(org-timer--run-countdown-timer
 		 secs org-timer-countdown-timer-title))
 	  (run-hooks 'org-timer-set-hook)
-	  ;; Pass `current-time' result to `add-time' (instead nil) so
-	  ;; that only `current-time' has to be overridden in tests.
+	  ;; Pass `current-time' result to `time-add' (instead of nil)
+	  ;; for for Emacs 24 compatibility.
 	  (setq org-timer-start-time
 		(time-add (current-time) (seconds-to-time secs)))
 	  (setq org-timer-pause-time nil)

lisp/org.el

@@ -16225,12 +16225,9 @@ user."
 (defun org-read-date-analyze (ans def defdecode)
   "Analyze the combined answer of the date prompt."
   ;; FIXME: cleanup and comment
-  ;; Pass `current-time' result to `decode-time' (instead of calling
-  ;; without arguments) so that only `current-time' has to be
-  ;; overridden in tests.
   (let ((org-def def)
 	(org-defdecode defdecode)
-	(nowdecode (decode-time (current-time)))
+	(nowdecode (decode-time))
 	delta deltan deltaw deltadef year month day
 	hour minute second wday pm h2 m2 tl wday1
 	iso-year iso-weekday iso-week iso-date futurep kill-year)
@@ -16407,10 +16404,7 @@ user."
      (deltan
       (setq futurep nil)
       (unless deltadef
-	;; Pass `current-time' result to `decode-time' (instead of
-	;; calling without arguments) so that only `current-time' has
-	;; to be overridden in tests.
-	(let ((now (decode-time (current-time))))
+	(let ((now (decode-time)))
 	  (setq day (nth 3 now) month (nth 4 now) year (nth 5 now))))
       (cond ((member deltaw '("d" "")) (setq day (+ day deltan)))
 	    ((equal deltaw "w") (setq day (+ day (* 7 deltan))))

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

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

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.

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