aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2020-03-22 23:40:49 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2020-03-22 23:40:49 +0100
commit3c211e775f57a1a5a731bb4d059bafbaa581210d (patch)
tree38958e29cd9f58fa9192b7b196f14b3d60dee9b2
parentDate difference once again returns dates. (diff)
downloadcalp-3c211e775f57a1a5a731bb4d059bafbaa581210d.tar.gz
calp-3c211e775f57a1a5a731bb4d059bafbaa581210d.tar.xz
Fix TZ problem with datetime<.
-rw-r--r--module/datetime.scm16
-rw-r--r--tests/datetime-compare.scm6
2 files changed, 16 insertions, 6 deletions
diff --git a/module/datetime.scm b/module/datetime.scm
index 8df055de..2b330a9c 100644
--- a/module/datetime.scm
+++ b/module/datetime.scm
@@ -262,14 +262,18 @@
(time< a b)))
(define-public (datetime< a b)
- (if (date= (get-date a) (get-date b))
- (time< (get-time a) (get-time b))
- (date< (get-date a) (get-date b))))
+ (let ((a (get-datetime a))
+ (b (get-datetime b)))
+ (if (date= (get-date a) (get-date b))
+ (time< (get-time% a) (get-time% b))
+ (date< (get-date a) (get-date b)))))
(define-public (datetime<= a b)
- (if (date= (get-date a) (get-date b))
- (time<= (get-time a) (get-time b))
- (date<= (get-date a) (get-date b))))
+ (let ((a (get-datetime a))
+ (b (get-datetime b)))
+ (if (date= (get-date a) (get-date b))
+ (time<= (get-time% a) (get-time% b))
+ (date<= (get-date a) (get-date b)))))
(define-public (date/-time< a b)
(datetime< (as-datetime a) (as-datetime b)))
diff --git a/tests/datetime-compare.scm b/tests/datetime-compare.scm
index eab2b949..cd077e87 100644
--- a/tests/datetime-compare.scm
+++ b/tests/datetime-compare.scm
@@ -64,6 +64,12 @@
(test-assert "date/-time< other dt, same date"
(date/-time< #2020-01-01 #2020-01-01T10:00:00))
+;; In UTC+2 (CEST) the below datetime overflows into midnight the following
+;; day. Earlier versions of this program only looked at the time component
+(test-assert "date/-time< TZ overflow"
+ (date/-time< #2020-04-05
+ (datetime date: #2020-04-05 time: #22:00:00 tz: "UTC")))
+
(test-assert "date/-time< time-only"
(date/-time< #00:00:00 #10:00:00))