branch: externals/org
commit 51a9eb17c71452f2e97e6ab8df409dc651ec90a3
Author: Morgan Smith <[email protected]>
Commit: Ihor Radchenko <[email protected]>
Testing: Use advice to override time functions
When including files that have been compiled that run this macro one
would sometimes get the error "Invalid read syntax #<".
By using advice things seem to work without error now.
* testing/org-test.el (org-test-at-time): Advise time functions with
`add-function' instead of directly setting the functions with
`cl-letf'.
---
testing/org-test.el | 102 ++++++++++++++++++++++++++++------------------------
1 file changed, 56 insertions(+), 46 deletions(-)
diff --git a/testing/org-test.el b/testing/org-test.el
index 28e095440b..c21c428350 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -507,52 +507,62 @@ TIME can be a non-nil Lisp time value, or a string
specifying a date and time."
(,at (if (stringp ,tm)
(org-time-string-to-time ,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 zone form)
- (condition-case nil
- (funcall ,(symbol-function 'decode-time)
- (or time ,at) zone form)
- (wrong-number-of-arguments
- (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))))
+ (cl-flet
+ ((org-test-current-time (_fun &rest _args)
+ ,at)
+ (org-test-current-time-string (fun &optional time &rest args)
+ (apply fun
+ (or time ,at) args))
+ (org-test-current-time-zone (fun &optional time &rest args)
+ (apply fun (or time ,at) args))
+ (org-test-decode-time (fun &optional time zone form)
+ (condition-case nil
+ (funcall fun (or time ,at) zone form)
+ (wrong-number-of-arguments
+ (funcall fun (or time ,at)))))
+ (org-test-encode-time (fun time &rest args)
+ (apply fun (or time ,at) args))
+ (org-test-float-time (fun &optional time)
+ (funcall fun (or time ,at)))
+ (org-test-format-time-string (fun format &optional time &rest args)
+ (apply fun format (or time ,at) args))
+ (org-test-set-file-times (fun file &optional time)
+ (funcall fun file (or time ,at)))
+ (org-test-time-add (fun a b)
+ (funcall fun (or a ,at) (or b ,at)))
+ (org-test-time-equal-p (fun a b)
+ (funcall fun (or a ,at) (or b ,at)))
+ (org-test-time-less-p (fun a b)
+ (funcall fun (or a ,at) (or b ,at)))
+ (org-test-time-subtract (fun a b)
+ (funcall fun (or a ,at) (or b ,at))))
+ (add-function :around (symbol-function 'current-time)
#'org-test-current-time)
+ (add-function :around (symbol-function 'current-time-string)
#'org-test-current-time-string)
+ (add-function :around (symbol-function 'current-time-zone)
#'org-test-current-time-zone)
+ (add-function :around (symbol-function 'decode-time)
#'org-test-decode-time)
+ (add-function :around (symbol-function 'encode-time)
#'org-test-encode-time)
+ (add-function :around (symbol-function 'float-time)
#'org-test-float-time)
+ (add-function :around (symbol-function 'format-time-string)
#'org-test-format-time-string)
+ (add-function :around (symbol-function 'set-file-times)
#'org-test-set-file-times)
+ (add-function :around (symbol-function 'time-add)
#'org-test-time-add)
+ (add-function :around (symbol-function 'time-equal-p)
#'org-test-time-equal-p)
+ (add-function :around (symbol-function 'time-less-p)
#'org-test-time-less-p)
+ (add-function :around (symbol-function 'time-subtract)
#'org-test-time-subtract)
+
+ (unwind-protect
+ (progn ,@body)
+ (remove-function (symbol-function 'current-time)
#'org-test-current-time)
+ (remove-function (symbol-function 'current-time-string)
#'org-test-current-time-string)
+ (remove-function (symbol-function 'current-time-zone)
#'org-test-current-time-zone)
+ (remove-function (symbol-function 'decode-time)
#'org-test-decode-time)
+ (remove-function (symbol-function 'encode-time)
#'org-test-encode-time)
+ (remove-function (symbol-function 'float-time)
#'org-test-float-time)
+ (remove-function (symbol-function 'format-time-string)
#'org-test-format-time-string)
+ (remove-function (symbol-function 'set-file-times)
#'org-test-set-file-times)
+ (remove-function (symbol-function 'time-add)
#'org-test-time-add)
+ (remove-function (symbol-function 'time-equal-p)
#'org-test-time-equal-p)
+ (remove-function (symbol-function 'time-less-p)
#'org-test-time-less-p)
+ (remove-function (symbol-function 'time-subtract)
#'org-test-time-subtract))))))
(defmacro org-test-capture-warnings (&rest body)
"Capture all warnings passed to `org-display-warning' within BODY."
