diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2020-01-20 22:43:46 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2020-01-20 22:43:46 +0100 |
commit | 4a299cb7a232c94e1cefc5b51cb45f0d9ef4ca0f (patch) | |
tree | c78d50f60ea18512a7e4fc8ff548cefaf7111f41 | |
parent | Fix termios tests. (diff) | |
download | calp-4a299cb7a232c94e1cefc5b51cb45f0d9ef4ca0f.tar.gz calp-4a299cb7a232c94e1cefc5b51cb45f0d9ef4ca0f.tar.xz |
Add normilze-date/tz.
-rw-r--r-- | module/srfi/srfi-19/util.scm | 4 | ||||
-rw-r--r-- | tests/time.scm | 58 |
2 files changed, 62 insertions, 0 deletions
diff --git a/module/srfi/srfi-19/util.scm b/module/srfi/srfi-19/util.scm index 96aa6a48..77e824ca 100644 --- a/module/srfi/srfi-19/util.scm +++ b/module/srfi/srfi-19/util.scm @@ -124,6 +124,10 @@ attribute set to 0. Can also be seen as \"Start of day\"" (make-time time-duration 0 7200)))) (set (date-second next-date) 0)) +(define*-public (normalize-date/tz date #:optional (tz "Europe/Stockholm")) + (let-env ((TZ tz)) + (-> date date->time-utc time-utc->date))) + ;; date x (date → date) → stream<date> (define (date-increment-stream* start-date transfer-proc) (stream-iterate diff --git a/tests/time.scm b/tests/time.scm new file mode 100644 index 00000000..65edfcbd --- /dev/null +++ b/tests/time.scm @@ -0,0 +1,58 @@ +(((srfi srfi-19 util) + date day-stream normalize-date + drop-time normalize-date/tz + ) + ((util) set let-env) + ((srfi srfi-19) date-day) + ) + +(test-equal "Trivial normalize case" + (date year: 2020 month: 1 day: 1 tz: 0) + (normalize-date (date year: 2020 month: 1 day: 1 tz: 0))) + +(test-equal "Trivial case, with timezone" + (date year: 2020 month: 1 day: 1 tz: 3600) + (normalize-date (date year: 2020 month: 1 day: 1 tz: 3600))) + +;;; summer time begins 02:00 (becomes 03:00) during the night +;;; between the 28 and 29 of mars 2020, for Europe/Stockholm. +;;; (CET → CEST alt. UTC+1 → UTC+2) + +(test-equal "Time zone spill over" + (date year: 2020 month: 3 day: 29 tz: 3600) + (normalize-date (set (date-day (date year: 2020 month: 3 day: 28 tz: 3600)) + = (+ 1)))) + +;;; TODO normalize-date* + + + +;;; !!! TODO !!! + +(test-assert "normalize-date/tz" + (not (unspecified? (normalize-date/tz (date))))) + +(test-equal "Trivial normalize case" + (date year: 2020 month: 1 day: 1 hour: 1 tz: 3600) + (normalize-date/tz (date year: 2020 month: 1 day: 1 tz: 0) + "Europe/Stockholm")) + +(test-equal "Trivial case, with timezone" + (date year: 2020 month: 1 day: 1 tz: 3600) + (normalize-date/tz (date year: 2020 month: 1 day: 1 tz: 3600) + "Europe/Stockholm")) + +(test-equal "Time zone spill over" + (date year: 2020 month: 3 day: 30 hour: 1 tz: 7200) + (normalize-date/tz (set (date-day (date year: 2020 month: 3 day: 29 tz: 3600)) + = (+ 1)) + "Europe/Stockholm")) + + + + +(test-equal "drop time" + (date) + (drop-time (date hour: 10 minute: 70 second: 100))) + + |