aboutsummaryrefslogtreecommitdiff
path: root/tests/unit/datetime
diff options
context:
space:
mode:
Diffstat (limited to 'tests/unit/datetime')
-rw-r--r--tests/unit/datetime/datetime.scm812
-rw-r--r--tests/unit/datetime/timespec.scm98
-rw-r--r--tests/unit/datetime/tz.scm88
-rw-r--r--tests/unit/datetime/zic.scm319
4 files changed, 1317 insertions, 0 deletions
diff --git a/tests/unit/datetime/datetime.scm b/tests/unit/datetime/datetime.scm
new file mode 100644
index 00000000..9f32d4a1
--- /dev/null
+++ b/tests/unit/datetime/datetime.scm
@@ -0,0 +1,812 @@
+(define-module (test datetime)
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-64 test-error)
+ :use-module (srfi srfi-71)
+ :use-module (srfi srfi-88)
+ :use-module ((srfi srfi-41)
+ :select (stream->list stream-take))
+ :use-module (datetime)
+ :use-module ((ice-9 format) :select (format))
+ :use-module ((ice-9 i18n) :select (make-locale))
+ :use-module ((guile) :select (LC_CTYPE LC_TIME)))
+
+;;; Skipped since the code generating the (expected) error is disabled, due to
+;;; optional fields at the end of string. See the (null? str) case is
+;;; datetime->string
+(test-expect-fail "Premature end of string to parse")
+
+;;; Global locale objects, to save all tests from creating them
+(define en_US (make-locale (list LC_CTYPE LC_TIME) "en_US.UTF-8"))
+(define sv_SE (make-locale (list LC_CTYPE LC_TIME) "sv_SE.UTF-8"))
+
+;;; These tests begin by testing the basic objects,
+;;; followed by the string parser.
+;;; This to finally test the read syntax, to be able to
+;;; us it in the rest of the tests.
+
+(test-group "Creation of basic objects"
+ (test-group "Date"
+ (test-group "Empty date"
+ (let ((d (date)))
+ (test-assert "Date creates date objects" (date? d))
+ (test-equal "Year is zero" 0 (year d))
+ (test-equal "Month is zero" 0 (month d))
+ (test-equal "Day is zero" 0 (day d))
+ (test-assert "Date-zero? agrees" (date-zero? d))))
+
+ (test-group "Date with keys"
+ ;; Implicitly tests that month and day can go above
+ ;; "regular" bounds
+ (let ((d (date day: 40 month: 20 year: 10)))
+ (test-assert "Date creation still works" (date? d))
+ (test-equal "Year is stored" 10 (year d))
+ (test-equal "Month is stored" 20 (month d))
+ (test-equal "Day is stored" 40 (day d))))
+
+ (test-group "Can't create date with non-integer components"
+ (test-error "Invalid year" 'wrong-type-arg (date year: #f))
+ (test-error "Invalid month" 'wrong-type-arg (date month: #f))
+ (test-error "Invalid day" 'wrong-type-arg (date day: #f))))
+
+ (test-group "Time"
+ (test-group "Empty time"
+ (let ((t (time)))
+ (test-assert "Time creates time objects" (time? t))
+ (test-equal "hour is zero" 0 (hour t))
+ (test-equal "minute is zero" 0 (minute t))
+ (test-equal "second is zero" 0 (second t))
+ (test-assert "Time zero agrees" (time-zero? t))))
+
+ (test-group "Time with keys"
+ (let ((t (time second: 10 minute: 20 hour: 30)))
+ (test-assert "Time creation still works" (time? t))
+ (test-equal "Hour is stored" 30 (hour t))
+ (test-equal "Minute is stored" 20 (minute t))
+ (test-equal "Second is stored" 10 (second t))))
+
+ (test-group "Can't create time with non-integer components"
+ (test-error "Invalid hour" 'wrong-type-arg (time hour: #f))
+ (test-error "Invalid minute" 'wrong-type-arg (time minute: #f))
+ (test-error "Invalid second" 'wrong-type-arg (time second: #f))))
+
+ (test-group "Datetime"
+ (let ()
+ (test-group "Empty datetime"
+ (let ((dt (datetime)))
+ (test-assert "Datetime date is date" (date? (datetime-date dt)))
+ (test-assert "Datetime date is zero" (date-zero? (datetime-date dt)))
+ (test-assert "Datetime time is time" (time? (datetime-time dt)))
+ (test-assert "Datetime time is zero" (time-zero? (datetime-time dt)))
+ (test-eqv "Defalut timezone is #f" #f (tz dt))))
+
+ (test-group "Datetime with keys"
+ (let ((dt (datetime date: (date day: 10)
+ time: (time minute: 20))))
+ (test-equal "Given date is stored"
+ 10 (day (datetime-date dt)))
+ (test-equal "Given time is stored"
+ 20 (minute (datetime-time dt))))
+ (test-error "Date must be a date" 'wrong-type-arg (datetime date: 1))
+ (test-error "Date must be a date" 'wrong-type-arg (datetime date: (time)))
+ (test-assert "Date: #f gives still constructs a date" (date? (datetime-date (datetime date: #f))))
+ (test-error "Time must be a time" 'wrong-type-arg (datetime time: 1))
+ (test-error "Time must be a time" 'wrong-type-arg (datetime time: (date)))
+ (test-assert "Time: #f gives still constructs a time" (time? (datetime-time (datetime time: #f))))
+
+ (let ((dt (datetime hour: 20 day: 30)))
+ (test-equal "Time objects can be implicitly created" 20 (hour (datetime-time dt)))
+ (test-equal "Date objects can be implicitly created" 30 (day (datetime-date dt))))
+ (let ((dt (datetime day: 30 time: (time hour: 20))))
+ (test-equal "\"Upper\" and \"lower\" keys can be mixed"
+ 20 (hour (datetime-time dt)))
+ (test-equal "\"Upper\" and \"lower\" keys can be mixed"
+ 30 (day (datetime-date dt))))
+
+ (let ((dt (datetime hour: 30 time: (time hour: 20))))
+ (test-equal "time: has priority over hour: (and the like)"
+ 20 (hour (datetime-time dt)))))
+ (let ((dt (datetime day: 30 date: (date day: 20))))
+ (test-equal "date: has priority over day: (and the like)"
+ 20 (day (datetime-date dt)))))))
+
+;; Before the general parser, since it's a dependency string->datetime.
+(test-group "Parse Month"
+
+ (test-equal "Parse full month name" jan (parse-month "January" en_US))
+ (test-equal "Parse full weird case" jan (parse-month "jaNuaRy" en_US))
+ (test-equal "Parse partial month name" jan (parse-month "Jan" en_US))
+ (test-equal "Failing parse of month name" -1 (parse-month "Unknown" en_US))
+ (test-equal "Overlap gives earliest month" mar (parse-month "m" en_US))
+
+ (test-equal "Parse month with different locale" may (parse-month "maj" sv_SE)))
+
+
+(test-group "Parser"
+ (test-group "Simple individual rules"
+ (test-group "Year"
+ (test-equal "~Y year" (datetime year: 2020) (string->datetime "2020" "~Y"))
+ (test-equal "~Y year single digit" (datetime year: 2) (string->datetime "2" "~Y"))
+ (test-equal "~Y year leading zero" (datetime year: 2) (string->datetime "02" "~Y"))
+ (test-error "~Y parses at max four digits" 'misc-error (string->datetime "14411" "~Y")))
+
+ (test-group "Month"
+ (test-equal "~m month" (datetime month: 10) (string->datetime "10" "~m"))
+ (test-equal "~m month single digit" (datetime month: 1) (string->datetime "1" "~m"))
+ (test-equal "~m month leading zero" (datetime month: 1) (string->datetime "01" "~m"))
+ (test-error "~m parses at max two digits" 'misc-error (string->datetime "111" "~m")))
+
+ ;; Extra tests are skipped for these, since they are shared with Month
+ (test-equal "~d day" (datetime day: 20) (string->datetime "20" "~d"))
+ (test-equal "~H hour" (datetime hour: 15) (string->datetime "15" "~H"))
+ (test-equal "~M minute" (datetime minute: 30) (string->datetime "30" "~M"))
+ (test-equal "~S second" (datetime second: 59) (string->datetime "59" "~S")))
+
+
+ (test-equal "Literal character" (datetime) (string->datetime "T" "T"))
+ (test-equal "~~ '~'" (datetime) (string->datetime "~" "~~"))
+ (test-error "Mismatched literal ~" 'misc-error (string->datetime "A" "~~"))
+
+ (test-error "Stray ~ at end of fmt" 'misc-error (string->datetime "~" "~"))
+ (test-error "Stray ~ in middle of fmt" 'misc-error (string->datetime "~ 1" "~ ~d"))
+ (test-error "Unknown escape" 'misc-error (string->datetime "10" "~x"))
+ (test-error "Premature end of string to parse" 'misc-error (string->datetime "" "~Y"))
+ (test-error "Wrong Literal character" 'misc-error (string->datetime "T" "Z"))
+
+
+ ;; Does the parser continue correctly
+ (test-group "Tokens following each other"
+ (test-equal "Year indirectly followed by month"
+ (datetime year: 2020 month: 1)
+ (string->datetime "2020-01" "~Y-~m"))
+ ;; Does the parser handle tokens without delimiters, instead going by their max size
+ (test-equal "Year directly follewed by month"
+ (datetime year: 2020 month: 1)
+ (string->datetime "202001" "~Y~m")))
+
+
+ (test-group "Timezone"
+ (test-equal "~Z 'Z'"
+ (datetime tz: "UTC") (string->datetime "Z" "~Z"))
+ (test-equal "~Z Is optional"
+ (datetime) (string->datetime "" "~Z"))
+ (test-equal "~Z Is optional with stuff after"
+ (datetime hour: 20) (string->datetime "20" "~Z~H"))
+ ;; This was earlier a bug
+ (test-equal "Zoneinfo is kept while not at end"
+ (datetime year: 2020 tz: "UTC")
+ (string->datetime "Z2020" "~Z~Y")))
+
+
+ (test-group "Month by name"
+ ;; ~b, ~B, and ~h all does the same thing, and exists for symmetry with
+ ;; datetime->string (where they don't do the exact same thing). Each is used
+ ;; at least once below to ensure that they all work.
+ (test-equal "Standalone month, and at end"
+ (datetime month: 1)
+ (string->datetime "Jan" "~b" en_US))
+
+ ;; Separate test from above, since month does the check itself
+ (test-error "Stray ~ after month"
+ 'misc-error (string->datetime "Jan" "~b~" en_US))
+
+ (test-equal "Month with explicit ~ after"
+ (datetime month: mar)
+ (string->datetime "M~" "~B~~" en_US))
+
+ (test-error "Month with other specifier directly after"
+ 'misc-error (string->datetime "January" "~b~b"))
+
+ (test-equal "Month with other explict char after"
+ (datetime month: mar)
+ (string->datetime "Mar|" "~h|" en_US))
+
+ (test-equal "Locale information is used"
+ (datetime month: may)
+ (string->datetime "Maj" "~h" sv_SE)))
+
+ ;; TODO AM/PM string ~p
+
+ (test-group "Complete parses"
+ (test-equal "Parse complete ISO date"
+ (datetime year: 2020 month: 3 day: 10)
+ (string->datetime "2020-03-10" "~Y-~m-~d"))
+
+ (test-equal "Parse complete ISO time"
+ (datetime hour: 10 minute: 20 second: 30)
+ (string->datetime "10:20:30" "~H:~M:~S"))
+
+ (test-equal "Parse complete ISO date-time"
+ (datetime year: 2020 month: 3 day: 10
+ hour: 10 minute: 20 second: 30)
+ (string->datetime "2020-03-10T10:20:30"
+ "~Y-~m-~dT~H:~M:~S")))
+
+ (test-group "string->datetime default format-specifier"
+ (test-equal "Default date-time format-specifier takes ISO date-times"
+ (datetime year: 2020 month: 3 day: 10
+ hour: 10 minute: 20 second: 30)
+ (string->datetime "2020-03-10T10:20:30"))
+
+ (test-equal "Default date-time format-specifier takes ISO date-times (with zone)"
+ (datetime year: 2020 month: 3 day: 10
+ hour: 10 minute: 20 second: 30
+ tz: "UTC")
+ (string->datetime "2020-03-10T10:20:30Z")))
+
+
+ (test-group "string->time"
+ (test-assert "String->time returns time objects"
+ (time? (string->time "10" "~H")))
+
+ (test-equal "String->time complete parse"
+ (time hour: 10 minute: 20 second: 30)
+ (string->time "10:20:30" "~H:~M:~S"))
+
+ (test-equal "String->time complete parse, default format-specifier"
+ (time hour: 10 minute: 20 second: 30)
+ (string->time "10:20:30")))
+
+ (test-group "string->date"
+ (test-assert "String->date returns time objects"
+ (date? (string->date "10" "~Y")))
+
+ (test-equal "String->date complete parse"
+ (date year: 2020 month: 3 day: 10)
+ (string->date "2020-03-10" "~Y-~m-~d"))
+
+ (test-equal "String->date complete parse, default format-specifier"
+ (date year: 2020 month: 3 day: 10)
+ (string->date "2020-03-10")))
+
+ (test-group "Pre-specified parsers"
+ (test-group "ICS (RFC 5545)"
+ (test-equal "date"
+ (date year: 2020 month: 10 day: 20)
+ (parse-ics-date "20201020"))
+ (test-equal "time"
+ (time hour: 10 minute: 20 second: 30)
+ (parse-ics-time "102030"))
+ (test-equal "datetime"
+ (datetime year: 2020 month: 10 day: 20
+ hour: 10 minute: 20 second: 30)
+ (parse-ics-datetime "20201020T102030"))
+ (test-equal "datetime (with zone)"
+ (datetime year: 2020 month: 10 day: 20
+ hour: 10 minute: 20 second: 30
+ tz: "UTC")
+ (parse-ics-datetime "20201020T102030Z")))
+
+ (test-group "ISO"
+ (test-equal "date"
+ (date year: 2020 month: 10 day: 20)
+ (parse-iso-date "2020-10-20"))
+ (test-equal "time"
+ (time hour: 10 minute: 20 second: 30)
+ (parse-iso-time "10:20:30"))
+ (test-equal "datetime"
+ (datetime year: 2020 month: 10 day: 20
+ hour: 10 minute: 20 second: 30)
+ (parse-iso-datetime "2020-10-20T10:20:30")))
+
+ ;; Parse freeform date
+ )
+
+ (test-group "string->date/-time"
+ (test-equal "Date like gives date"
+ (date year: 2020 month: 10 day: 20)
+ (string->date/-time "2020-10-20"))
+ (test-equal "Time like gives time"
+ (time hour: 10 minute: 20 second: 30)
+ (string->date/-time "10:20:30"))
+ (test-equal "Datetime like gives datetime"
+ (datetime year: 2020 month: 10 day: 20
+ hour: 10 minute: 20 second: 30)
+ (string->date/-time "2020-10-20T10:20:30"))
+
+ ;; These are disabled since trailing fmt is allowed
+ ;; (test-error "Bad date-like crashes"
+ ;; 'misc-error (string->date/-time "2020-10"))
+ ;; (test-error "Bad time-like crashes"
+ ;; 'misc-error (string->date/-time "20:10"))
+ (test-error "Really bad crashes"
+ 'misc-error (string->date/-time "Hello"))
+ ))
+
+
+(test-group "Reader extensions"
+
+ ;; All tests have a list variant, to ensure that it plays nice with the rest
+ ;; of scheme's syntax
+
+ (test-equal "Basic time read syntax"
+ (time hour: 10 minute: 20 second: 30)
+ (test-read-eval-string "#10:20:30"))
+
+ (test-equal "Basic time read syntax in list"
+ (list (time hour: 10 minute: 20 second: 30))
+ (test-read-eval-string "(list #10:20:30)"))
+
+ (test-equal "Basic date read syntax"
+ (date year: 2020 month: 3 day: 10)
+ (test-read-eval-string "#2020-03-10"))
+
+ (test-equal "Basic date read syntax in list"
+ (list (date year: 2020 month: 3 day: 10))
+ (test-read-eval-string "(list #2020-03-10)"))
+
+ (test-equal "Basic datetime read syntax"
+ (datetime date: (date year: 2020 month: 3 day: 10)
+ time: (time hour: 10 minute: 20 second: 30))
+ (test-read-eval-string "#2020-03-10T10:20:30"))
+
+ (test-equal "Basic datetime read syntax in list"
+ (list (datetime date: (date year: 2020 month: 3 day: 10)
+ time: (time hour: 10 minute: 20 second: 30)))
+ (test-read-eval-string "(list #2020-03-10T10:20:30)"))
+
+ (test-equal "Basic datetime read syntax with Z"
+ (datetime date: (date year: 2020 month: 3 day: 10)
+ time: (time hour: 10 minute: 20 second: 30)
+ tz: "UTC")
+ (test-read-eval-string "#2020-03-10T10:20:30Z"))
+
+ (test-equal "Basic datetime read syntax with Z in list"
+ (list
+ (datetime date: (date year: 2020 month: 3 day: 10)
+ time: (time hour: 10 minute: 20 second: 30)
+ tz: "UTC"))
+ (test-read-eval-string "(list #2020-03-10T10:20:30Z)"))
+ )
+
+
+
+
+(test-equal "Datetime->unix-time"
+ 1656005146 (datetime->unix-time (datetime year: 2022 month: 06 day: 23 hour: 17 minute: 25 second: 46 tz: "UTC")))
+
+(test-equal "Datetime->unix-time before epoch"
+ -62167219200
+ (datetime->unix-time (datetime year: 0000 month: 01 day: 01 hour: 00 minute: 00 second: 00 tz: "UTC")))
+
+(test-equal "unix-time->datetime" (datetime year: 2020 month: 09 day: 13 hour: 12 minute: 26 second: 40 tz: "UTC")
+ (unix-time->datetime 1600000000))
+(test-equal "unix-time->datetime on epoch" (datetime year: 1970 month: 01 day: 01 hour: 00 minute: 00 second: 00 tz: "UTC")
+ (unix-time->datetime 0))
+(test-equal "unix-time->datetime before epoch" (datetime year: 1919 month: 04 day: 20 hour: 11 minute: 33 second: 20 tz: "UTC")
+ (unix-time->datetime -1600000000))
+
+;; (unix-time->datetime (expt 2 31)) ; => (datetime year: 2038 month: 01 day: 19 hour: 03 minute: 14 second: 08 tz: "UTC")
+;; (unix-time->datetime (1+ (expt 2 31))) ; => (datetime year: 2038 month: 01 day: 19 hour: 03 minute: 14 second: 09 tz: "UTC")
+;; (unix-time->datetime (- (expt 2 31))) ; => (datetime year: 1901 month: 12 day: 13 hour: 20 minute: 45 second: 52 tz: "UTC")
+
+
+(test-assert "Current datetime returns a datetime"
+ (datetime? (current-datetime)))
+(test-equal "Current datetime returns with tz: UTC"
+ "UTC" (tz (current-datetime)))
+(test-assert "Current-date returns a date"
+ (date? (current-date)))
+
+
+;; TODO write these, also, check connection to get-time%
+get-datetime
+as-date
+as-time
+as-datetime
+
+(test-group "Leap years"
+ (test-assert "Most years are't leap years" (not (leap-year? 1999)))
+ (test-assert "Except if it's divisible by 4" (leap-year? 2020))
+ (test-assert "But not by 100" (not (leap-year? 1900)))
+ (test-assert "Except if also divisible by 400" (leap-year? 2000)))
+
+(test-assert "31 days in most month" (days-in-month (date month: jan)))
+(test-assert "30 days in some month" (days-in-month (date month: apr)))
+(test-assert "28 days in februrary on regular year"
+ (days-in-month (date month: feb year: 2022)))
+(test-assert "29 days in februrary on leap year"
+ (days-in-month (date month: feb year: 2000)))
+(test-error "To low month" 'out-of-range (days-in-month (date month: 0)))
+(test-error "To high month" 'out-of-range (days-in-month (date month: 13)))
+
+(test-equal "365 days in regular year" 365 (days-in-year (date year: 2022)))
+(test-equal "366 days in leap year" 366 (days-in-year (date year: 2000)))
+
+(test-equal "Start of month" (date year: 2020 month: 01 day: 01) (start-of-month (date year: 2020 month: 01 day: 15)))
+(test-equal "End of month" (date year: 2000 month: 02 day: 29) (end-of-month (date year: 2000 month: 02 day: 01)))
+
+(test-equal "Start of year" (date year: 2020 month: 01 day: 01) (start-of-year (date year: 2020 month: 12 day: 31)))
+;; Note that end-of-year (apparently) doesn't exist
+
+(test-group "Date streams"
+ (test-equal "Day stream"
+ (list (date year: 2020 month: 01 day: 01) (date year: 2020 month: 01 day: 02) (date year: 2020 month: 01 day: 03) (date year: 2020 month: 01 day: 04) (date year: 2020 month: 01 day: 05))
+ (stream->list 5 (day-stream (date year: 2020 month: 01 day: 01))))
+ (test-equal "Week stream"
+ (list (date year: 2020 month: 01 day: 01) (date year: 2020 month: 02 day: 01) (date year: 2020 month: 03 day: 01) (date year: 2020 month: 04 day: 01) (date year: 2020 month: 05 day: 01))
+ (stream->list 5 (month-stream (date year: 2020 month: 01 day: 01))))
+ (test-equal "Month stream"
+ (list (date year: 2020 month: 01 day: 01) (date year: 2020 month: 01 day: 08) (date year: 2020 month: 01 day: 15) (date year: 2020 month: 01 day: 22) (date year: 2020 month: 01 day: 29))
+ (stream->list 5 (week-stream (date year: 2020 month: 01 day: 01)))))
+
+;; See time< tests for more context
+(test-group "Min/max"
+ (test-equal "Time min"
+ (time hour: 07 minute: 40 second: 50) (time-min (time hour: 10 minute: 20 second: 30) (time hour: 07 minute: 40 second: 50)))
+ (test-equal "Time max"
+ (time hour: 10 minute: 20 second: 30) (time-max (time hour: 10 minute: 20 second: 30) (time hour: 07 minute: 40 second: 50)))
+
+ (test-equal "Date min"
+ (date year: 2020 month: 02 day: 02) (date-min (date year: 2020 month: 02 day: 02) (date year: 2020 month: 03 day: 01)))
+ (test-equal "Date max"
+ (date year: 2020 month: 03 day: 01) (date-max (date year: 2020 month: 02 day: 02) (date year: 2020 month: 03 day: 01)))
+
+ (test-equal "Datetime min"
+ (datetime year: 2020 month: 02 day: 02 hour: 10 minute: 20 second: 30) (datetime-min (datetime year: 2020 month: 02 day: 02 hour: 10 minute: 20 second: 30) (datetime year: 2020 month: 03 day: 01 hour: 07 minute: 40 second: 50)))
+ (test-equal "Datetime max"
+ (datetime year: 2020 month: 03 day: 01 hour: 07 minute: 40 second: 50) (datetime-max (datetime year: 2020 month: 02 day: 02 hour: 10 minute: 20 second: 30) (datetime year: 2020 month: 03 day: 01 hour: 07 minute: 40 second: 50))))
+
+(test-equal "Week day" thu (week-day (date year: 2022 month: 06 day: 23)))
+
+(test-equal "week-1-start" (date year: 2019 month: 12 day: 30) (week-1-start (date year: 2020 month: 01 day: 01) mon))
+
+;; Possibly add case where the end of the year uses next years week numbers
+(test-equal "Week number at end of year" 53 (week-number (date year: 2008 month: 12 day: 31) sun))
+(test-equal "Week number at start of year" 53 (week-number (date year: 2009 month: 01 day: 01) sun))
+
+(test-equal (date year: 2008 month: 12 day: 28) (date-starting-week 53 (date year: 2008) sun))
+(test-equal (date year: 2007 month: 12 day: 30) (date-starting-week 1 (date year: 2008) sun))
+
+(test-group "Week day name"
+ (test-equal "Simple" "Saturday" (week-day-name sat locale: en_US))
+ (test-equal "Truncated" "Sa" (week-day-name sat 2 locale: en_US))
+ (test-equal "Other locale" "lördag" (week-day-name sat locale: sv_SE))
+ (test-equal "Other locale, truncated" "lö" (week-day-name sat 2 locale: sv_SE)))
+
+;; TODO timespans can be both date, times, and datetimes
+;; Check those cases?
+(test-group "Overlapping timespans"
+ ;; A B C D E ¬F
+ ;; |s1| : |s2| : |s1| : |s2| : : |s1|
+ ;; | | : | | : | ||s2| : |s1|| | : |s1||s2| : | |
+ ;; | ||s2| : |s1|| | : | || | : | || | : | || | :
+ ;; | | : | | : | || | : | || | : | || | : |s2|
+ ;; | | : | | : | | : | | : : | |
+ (test-assert "End of S1 overlaps start of S2"
+ (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)
+ (time hour: 11 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00)))
+ (test-assert "Start of S1 overlaps end of S2"
+ (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00)
+ (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)))
+ (test-assert "S1 complete encompasses S2"
+ (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00)
+ (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)))
+ (test-assert "S2 complete encompasses S1"
+ (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)
+ (time hour: 10 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00)))
+ (test-assert "S1 is equal to S2"
+ (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)
+ (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)))
+ (test-assert "S1 dosesn't overlap S2"
+ (not
+ (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 11 minute: 00 second: 00)
+ (time hour: 12 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00))))
+ (test-assert "If the events only share an instant they don't overlap"
+ (not
+ (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00)
+ (time hour: 12 minute: 00 second: 00) (time hour: 14 minute: 00 second: 00)))))
+
+(test-equal (date year: 2022 month: 06 day: 25) (find-first-week-day sat (date year: 2022 month: 06 day: 23)))
+
+(test-group "All weekdays in <>"
+ (test-equal "month, if starting from beginning of month"
+ (list (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24))
+ (all-wday-in-month fri (date year: 2022 month: 06 day: 01)))
+
+ (test-equal "month, if starting from the middle"
+ (list (date year: 2022 month: 06 day: 24))
+ (all-wday-in-month fri (date year: 2022 month: 06 day: 23)))
+
+ (test-equal "year, if starting from the beggining"
+ (list (date year: 2022 month: 01 day: 07) (date year: 2022 month: 01 day: 14) (date year: 2022 month: 01 day: 21) (date year: 2022 month: 01 day: 28) (date year: 2022 month: 02 day: 04) (date year: 2022 month: 02 day: 11) (date year: 2022 month: 02 day: 18) (date year: 2022 month: 02 day: 25) (date year: 2022 month: 03 day: 04) (date year: 2022 month: 03 day: 11) (date year: 2022 month: 03 day: 18) (date year: 2022 month: 03 day: 25) (date year: 2022 month: 04 day: 01) (date year: 2022 month: 04 day: 08) (date year: 2022 month: 04 day: 15) (date year: 2022 month: 04 day: 22) (date year: 2022 month: 04 day: 29) (date year: 2022 month: 05 day: 06) (date year: 2022 month: 05 day: 13) (date year: 2022 month: 05 day: 20) (date year: 2022 month: 05 day: 27) (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24) (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 08) (date year: 2022 month: 07 day: 15) (date year: 2022 month: 07 day: 22) (date year: 2022 month: 07 day: 29) (date year: 2022 month: 08 day: 05) (date year: 2022 month: 08 day: 12) (date year: 2022 month: 08 day: 19) (date year: 2022 month: 08 day: 26) (date year: 2022 month: 09 day: 02) (date year: 2022 month: 09 day: 09) (date year: 2022 month: 09 day: 16) (date year: 2022 month: 09 day: 23) (date year: 2022 month: 09 day: 30) (date year: 2022 month: 10 day: 07) (date year: 2022 month: 10 day: 14) (date year: 2022 month: 10 day: 21) (date year: 2022 month: 10 day: 28) (date year: 2022 month: 11 day: 04) (date year: 2022 month: 11 day: 11) (date year: 2022 month: 11 day: 18) (date year: 2022 month: 11 day: 25) (date year: 2022 month: 12 day: 02) (date year: 2022 month: 12 day: 09) (date year: 2022 month: 12 day: 16) (date year: 2022 month: 12 day: 23) (date year: 2022 month: 12 day: 30))
+ (all-wday-in-year fri (date year: 2022 month: 01 day: 01)))
+
+ (test-equal "year, if starting from the middle"
+ (list (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24) (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 08) (date year: 2022 month: 07 day: 15) (date year: 2022 month: 07 day: 22) (date year: 2022 month: 07 day: 29) (date year: 2022 month: 08 day: 05) (date year: 2022 month: 08 day: 12) (date year: 2022 month: 08 day: 19) (date year: 2022 month: 08 day: 26) (date year: 2022 month: 09 day: 02) (date year: 2022 month: 09 day: 09) (date year: 2022 month: 09 day: 16) (date year: 2022 month: 09 day: 23) (date year: 2022 month: 09 day: 30) (date year: 2022 month: 10 day: 07) (date year: 2022 month: 10 day: 14) (date year: 2022 month: 10 day: 21) (date year: 2022 month: 10 day: 28) (date year: 2022 month: 11 day: 04) (date year: 2022 month: 11 day: 11) (date year: 2022 month: 11 day: 18) (date year: 2022 month: 11 day: 25) (date year: 2022 month: 12 day: 02) (date year: 2022 month: 12 day: 09) (date year: 2022 month: 12 day: 16) (date year: 2022 month: 12 day: 23) (date year: 2022 month: 12 day: 30))
+ (all-wday-in-year fri (date year: 2022 month: 06 day: 01))))
+
+;; TODO
+in-date-range?
+
+(test-equal "weekday-list" (list wed thu fri sat sun mon tue) (weekday-list wed))
+(test-equal "start of week" (date year: 2022 month: 06 day: 20) (start-of-week (date year: 2022 month: 06 day: 23) mon))
+(test-equal "end of week" (date year: 2022 month: 06 day: 26) (end-of-week (date year: 2022 month: 06 day: 23) mon))
+
+
+(test-group "month-days"
+ (call-with-values (lambda () (month-days (date year: 2022 month: 06 day: 01) mon))
+ (lambda (before actual after)
+ (test-equal "before" (list (date year: 2022 month: 05 day: 30) (date year: 2022 month: 05 day: 31)) before)
+ (test-equal "actual" (stream->list 30 (day-stream (date year: 2022 month: 06 day: 01))) actual)
+ (test-equal "after" (list (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 02) (date year: 2022 month: 07 day: 03)) after))))
+
+(test-group "Days in interval"
+ (test-equal "Steps from start to end of month" 31 (days-in-interval (date year: 2022 month: 01 day: 01) (date year: 2022 month: 01 day: 31)))
+ (test-error "Negative intervals should fail" 'misc-error (days-in-interval (date year: 2022 month: 01 day: 01) (date year: 2020 month: 01 day: 31))))
+
+(test-equal "Year day" 191 (year-day (date year: 2020 month: 07 day: 09)))
+
+(test-group "Convertions to decimal time"
+ (test-group "Time->decimal-hour"
+ (test-equal "Exact number of hours is whole number" 5.0 (time->decimal-hour (time hour: 5)))
+ (test-equal "Minutes are \"base\" 60" 5.5 (time->decimal-hour (time hour: 5 minute: 30)))
+ (test-equal "60 Minutes gives a whole hour" 6.0 (time->decimal-hour (time hour: 5 minute: 60)))
+ (test-equal "A second is the right length" (/ 1.0 3600) (time->decimal-hour (time second: 1))))
+
+ (test-group "Datetime->decimal-hour"
+ (test-equal "Datetimes without dates work as times"
+ 5.5 (datetime->decimal-hour (datetime hour: 5 minute: 30)))
+ (test-equal "Full day" 24.0 (datetime->decimal-hour (datetime day: 1)))
+ (test-error "Can't get length of month without information about which month"
+ 'misc-error (datetime->decimal-hour (datetime month: 1)))
+ (test-equal "Can get length of month if we have a month"
+ (* 31 24.0) (datetime->decimal-hour (datetime month: 1) (date year: 2020 month: 01 day: 01)))))
+
+;; TODO
+date-range
+
+(test-group "To string"
+ (test-group "Datetime->string"
+ (test-equal "A letter becomes itself"
+ "H" (datetime->string (datetime) "H"))
+ (test-group "Single rules"
+ (test-equal "~" (datetime->string (datetime) "~~"))
+ (test-equal "01" (datetime->string (datetime hour: 1) "~H"))
+ (test-equal " 1" (datetime->string (datetime hour: 1) "~k"))
+ (test-equal "02" (datetime->string (datetime minute: 2) "~M"))
+ (test-equal "03" (datetime->string (datetime second: 3) "~S"))
+ (test-equal "0002" (datetime->string (datetime year: 2) "~Y"))
+ (test-equal "02" (datetime->string (datetime month: 2) "~m"))
+ (test-equal "04" (datetime->string (datetime day: 4) "~d"))
+ (test-equal " 4" (datetime->string (datetime day: 4) "~e"))
+ (test-equal "1600000000" (datetime->string (datetime year: 2020 month: 09 day: 13 hour: 12 minute: 26 second: 40 tz: "UTC") "~s"))
+
+ (test-equal "2022-10-20" (datetime->string (datetime date: (date year: 2022 month: 10 day: 20)) "~1"))
+ (test-equal "10:20:30" (datetime->string (datetime time: (time hour: 10 minute: 20 second: 30)) "~3"))
+
+ (test-group "Locale dependant (en_US)"
+ (test-equal "Saturday" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~A" en_US))
+ (test-equal "Sat" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~a" en_US))
+ (test-equal "January" (datetime->string (datetime date: (date month: 1)) "~B" en_US))
+ (test-equal "Jan" (datetime->string (datetime date: (date month: 1)) "~b" en_US)))
+
+ (test-group "Locale dependant (sv_SE)"
+ (test-equal "lördag" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~A" sv_SE))
+ (test-equal "lör" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~a" sv_SE))
+ (test-equal "januari" (datetime->string (datetime date: (date month: 1)) "~B" sv_SE))
+ (test-equal "jan" (datetime->string (datetime date: (date month: 1)) "~b" sv_SE)))
+
+ (test-group "Timezone"
+ (test-equal "Z" (datetime->string (datetime tz: "UTC") "~Z"))
+ (test-equal "" (datetime->string (datetime tz: #f) "~Z"))
+ (test-equal "" (datetime->string (datetime tz: "Anything else") "~Z"))))
+
+
+ (test-equal "Default fomat specifier gives ISO-formatted date"
+ "2006-01-02T15:04:05" (datetime->string (datetime year: 2006 month: 01 day: 02 hour: 15 minute: 04 second: 05)))
+
+ (test-group "Invalid specifiers"
+ (test-equal "" (datetime->string (datetime) "~x" allow-unknown?: #t))
+ (test-error 'misc-error (datetime->string (datetime) "~x")))
+
+ (test-group "Print syntax for datatypes"
+ (test-equal "Date writer" "#2020-01-02" (with-output-to-string (lambda () (write (date year: 2020 month: 01 day: 02)))))
+ (test-equal "Time writer" "#20:30:40" (with-output-to-string (lambda () (write (time hour: 20 minute: 30 second: 40)))))
+ (test-equal "Datetime writer" "#2020-01-02T20:30:40" (with-output-to-string (lambda () (write (datetime year: 2020 month: 01 day: 02 hour: 20 minute: 30 second: 40)))))
+ (test-equal "Datetime writer (with tz)" "#2020-01-02T20:30:40Z" (with-output-to-string (lambda () (write (datetime year: 2020 month: 01 day: 02 hour: 20 minute: 30 second: 40 tz: "UTC")))))))
+
+ ;; Really basic tests, since these are rather thin wrappers
+ (test-equal "date->string" "0000-00-00" (date->string (date)))
+ (test-equal "time->string" "00:00:00" (time->string (time))))
+
+(test-group "Equals"
+ ;; date=?, time=?, and datetime=? are alias to their non-question-mark
+ ;; alternatives. Using them interchangably below.
+ (test-group "date"
+ (test-assert "Zero dates are all equal"
+ (date=))
+ (test-assert "A single date is equal to itself"
+ (date=? (date year: 2020 month: 10 day: 20)))
+ (test-assert "Two dates are equal to each other"
+ (date= (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 20)))
+ (test-assert "Two dates which are NOT equal to each other"
+ (not (date= (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 21))))
+ (test-assert "More than two dates which are all equal"
+ (date=? (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 20))))
+
+ (test-group "time"
+ (test-assert "Zero times are all equal"
+ (time=))
+ (test-assert "A single time is equal to itself"
+ (time=? (time hour: 20 minute: 30 second: 40)))
+ (test-assert "Two times are equal to each other"
+ (time= (time hour: 20 minute: 30 second: 40) (time hour: 20 minute: 30 second: 40)))
+ (test-assert "Two times which are NOT equal to each other"
+ (not (time= (time hour: 20 minute: 30 second: 40) (time hour: 10 minute: 30 second: 40))))
+ (test-assert "More than two times which are all equal"
+ (time=? (time hour: 20 minute: 30 second: 40) (time hour: 20 minute: 30 second: 40) (time hour: 20 minute: 30 second: 40))))
+
+ (test-group "Datetime"
+ (test-assert "Zero datetimes \"all\" are equal"
+ (datetime=))
+ (test-assert "A single datetime is equal to itself"
+ (datetime= (datetime)))
+ (test-assert "Two equal datetimes are equal"
+ (datetime= (datetime hour: 1) (datetime hour: 1)))
+ (test-assert "Two dissimmalar datetimes aren't equal"
+ (not (datetime= (datetime hour: 1) (datetime hour: 2))))
+
+ ;; NOTE timezone interactions are non-existant
+ (test-assert "Two datetimes are equal, regardless of timezone"
+ (datetime= (datetime) (datetime tz: "Something Else")))
+
+ (test-assert "Three equal datetimes are equal"
+ (datetime= (datetime hour: 1) (datetime hour: 1) (datetime hour: 1)))))
+
+(test-group "Comparisons"
+ (test-group "Zero arguments"
+ (test-group "Dates"
+ (test-assert "zero dates are greater" (date<))
+ (test-assert "zero dates are less" (date>)))
+ (test-group "Times"
+ (test-assert "zero times are greater" (time<))
+ (test-assert "zero times are less" (time>)))
+ (test-group "Datetimes"
+ (test-assert "zero datetimes are greater" (datetime<))
+ (test-assert "zero datetimes are less" (datetime>))))
+
+ (test-group "Single argument"
+ (test-group "Dates"
+ (test-assert "one date are greater" (date< (date)))
+ (test-assert "one date are less" (date> (date))))
+ (test-group "Times"
+ (test-assert "one time are greater" (time< (time)))
+ (test-assert "one time are less" (time> (time))))
+ (test-group "Datetimes"
+ (test-assert "one datetime are greater" (datetime< (datetime)))
+ (test-assert "one datetime are less" (datetime> (datetime)))))
+
+
+ (test-group "Two arguments"
+ (test-group "Dates"
+ (test-assert "positive comparison" (date< (date day: 1) (date day: 2)))
+ (test-assert "negative comparison" (not (date> (date day: 1) (date day: 2)))))
+ (test-group "Times"
+ (test-assert "positive comparison" (time< (time hour: 1) (time hour: 2)))
+ (test-assert "negative comparison" (not (time> (time hour: 1) (time hour: 2)))))
+ (test-group "Datetimes"
+ (test-assert "positive comparison" (datetime< (datetime day: 1) (datetime day: 2)))
+ (test-assert "negative comparison" (not (datetime> (datetime day: 1) (datetime day: 2))))))
+
+ (test-group "Two arguments"
+ (test-group "Dates"
+ (test-assert "positive comparison"
+ (date< (date day: 1) (date day: 2) (date day: 3)))
+ (test-assert "negative comparison"
+ (not (date< (date day: 1) (date day: 2) (date day: 1)))))
+ (test-group "Times"
+ (test-assert "positive comparison"
+ (time< (time hour: 1) (time hour: 2) (time hour: 3)))
+ (test-assert "negative comparison"
+ (not (date< (date day: 1) (date day: 2) (date day: 1)))))
+ (test-group "Datetimes"
+ (test-assert "positive comparison"
+ (datetime< (datetime day: 1) (datetime day: 2) (datetime day: 3)))
+ (test-assert "negative comparison"
+ (not (datetime< (datetime day: 1) (datetime day: 2) (datetime day: 1)))))))
+
+;; TODO
+date<=
+time<=
+datetime<=
+
+;; TODO
+date/-time< date/-time<? date/-time<= date/-time<=?
+date/-time> date/-time>? date/-time>= date/-time>=?
+
+(test-group "Arithmetic"
+ (test-group "Date"
+ (test-group "Unary application"
+ (test-equal "Date+ single argument returns itself" (date) (date+ (date)))
+ (test-equal "Date- single argument returns itself" (date) (date- (date))))
+
+ (test-group "Simple cases"
+ (test-group "Days"
+ (test-equal "Add" (date year: 2020 month: 01 day: 06) (date+ (date year: 2020 month: 01 day: 01) (date day: 5)))
+ (test-equal "Remove" (date year: 2020 month: 01 day: 01) (date- (date year: 2020 month: 01 day: 06) (date day: 5))))
+ (test-group "Months"
+ (test-equal "Add" (date year: 2020 month: 06 day: 01) (date+ (date year: 2020 month: 01 day: 01) (date month: 5)))
+ (test-equal "Remove" (date year: 2020 month: 01 day: 01) (date- (date year: 2020 month: 06 day: 01) (date month: 5))))
+ (test-group "Years"
+ (test-equal "Add" (date year: 2022 month: 01 day: 01) (date+ (date year: 2020 month: 01 day: 01) (date year: 2)))
+ (test-equal "Remove" (date year: 2020 month: 01 day: 01) (date- (date year: 2022 month: 01 day: 01) (date year: 2)))))
+
+ (test-group "Many operands"
+ (test-equal (date year: 2021 month: 02 day: 02)
+ (date+ (date year: 2020 month: 01 day: 01)
+ (date day: 1)
+ (date month: 1)
+ (date year: 1))))
+
+ (test-group "Overflow"
+ ;; Years don't overflow, so no need to test
+ (test-equal "Day overflow" (date year: 2022 month: 02 day: 01) (date+ (date year: 2022 month: 01 day: 31) (date day: 1)))
+ (test-equal "Month overflow" (date year: 2023 month: 01 day: 01) (date+ (date year: 2022 month: 12 day: 01) (date month: 1)))
+ (test-equal "Date+Month overflow" (date year: 2023 month: 01 day: 01) (date+ (date year: 2022 month: 12 day: 31) (date day: 1))))
+
+ ;; NOTE
+ (test-equal (date year: 2020 month: 02 day: 31) (date+ (date year: 2020 month: 01 day: 31) (date month: 1)))
+ )
+
+ (test-group "Time"
+ (test-group "Unary application"
+ (test-equal "Time+ single argument returns itself" (time) (time+ (time)))
+ (test-equal "Time- single argument returns itself" (time) (time- (time))))
+
+ (test-group "Simple cases"
+ (test-group "Seconds"
+ (test-equal "Add" (time hour: 20 minute: 00 second: 40) (time+ (time hour: 20 minute: 00 second: 00) (time second: 40)))
+ (test-equal "Remove" (time hour: 20 minute: 00 second: 00) (time- (time hour: 20 minute: 00 second: 40) (time second: 40))))
+ (test-group "Minutes"
+ (test-equal "Add" (time hour: 20 minute: 10 second: 00) (time+ (time hour: 20 minute: 00 second: 00) (time minute: 10)))
+ (test-equal "Remove" (time hour: 20 minute: 00 second: 00) (time- (time hour: 20 minute: 10 second: 00) (time minute: 10))))
+ (test-group "Hours"
+ (test-equal "Add" (time hour: 22 minute: 00 second: 00) (time+ (time hour: 20 minute: 00 second: 00) (time hour: 2)))
+ (test-equal "Remove" (time hour: 20 minute: 00 second: 00) (time- (time hour: 22 minute: 00 second: 00) (time hour: 2)))))
+
+ (test-group "Overflowing cases"
+ (test-group "Addition"
+ (test-group "Single overflow"
+ (call-with-values (lambda () (time+ (time hour: 20 minute: 00 second: 00) (time hour: 5)))
+ (lambda (result overflow)
+ (test-equal "Time" (time hour: 1) result)
+ (test-equal "Overflow" 1 overflow))))
+ (test-group "Mulitple overflows"
+ (call-with-values (lambda () (time+ (time hour: 20 minute: 00 second: 00) (time hour: 5) (time hour: 24)))
+ (lambda (result overflow)
+ (test-equal "Time" (time hour: 1) result)
+ (test-equal "Overflow" 2 overflow)))))
+
+ (test-group "Subtraction"
+ (test-group "Single overflow"
+ (call-with-values (lambda () (time- (time hour: 20 minute: 00 second: 00) (time hour: 25)))
+ (lambda (result overflow)
+ (test-equal "Time" (time hour: 19) result)
+ (test-equal "Overflow" 1 overflow))))
+ (test-group "Mulitple overflows"
+ (call-with-values (lambda () (time- (time hour: 4) (time hour: 10) (time hour: 24)))
+ (lambda (result overflow)
+ (test-equal "Time" (time hour: 18) result)
+ (test-equal "Overflow" 2 overflow))))))))
+
+;; TODO
+datetime+ datetime-
+
+(test-group "Date difference"
+ (test-assert "The differente between a date and itself is zero"
+ (date-zero? (date-difference (date year: 2022 month: 02 day: 02) (date year: 2022 month: 02 day: 02))))
+
+ (test-error "Later date must be first" 'misc-error
+ (date-difference (date year: 2020 month: 01 day: 01) (date year: 2021 month: 01 day: 01)))
+
+ (test-error "Negative months are invalid" 'misc-error
+ (date-difference (date) (date month: -1)))
+ (test-error "Negative days are invalid" 'misc-error
+ (date-difference (date) (date day: -1)))
+ (test-equal "Negative years ARE valid"
+ (date year: 1) (date-difference (date) (date year: -1))))
+
+;; TODO
+datetime-difference
+
+'((datetime))
diff --git a/tests/unit/datetime/timespec.scm b/tests/unit/datetime/timespec.scm
new file mode 100644
index 00000000..76fdd572
--- /dev/null
+++ b/tests/unit/datetime/timespec.scm
@@ -0,0 +1,98 @@
+(define-module (test timespec)
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-88)
+ :use-module (datetime)
+ :use-module (datetime timespec))
+
+(test-equal "The empty string parses to the empty timespec"
+ (timespec-zero) (parse-time-spec ""))
+
+(test-group "timespec-add"
+
+ (test-equal "Zero operands gives 0"
+ (timespec-zero) (timespec-add))
+
+ (let ((ts (make-timespec (time hour: 10 minute: 20 second: 30) '- #\z)))
+ (test-equal "Single operand gives that operand"
+ ts (timespec-add ts)))
+
+ (test-equal "0 + 0 = 0"
+ (timespec-zero) (timespec-add (timespec-zero) (timespec-zero)))
+
+ (test-group
+ "+ -"
+ (test-equal "Remove a number less than the base"
+ (make-timespec (time hour: 10 minute: 00 second: 00) '+ #\w)
+ (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30)
+ '+ #\w)
+ (make-timespec (time minute: 20 second: 30)
+ '- #\w)))
+
+ (test-equal "Remove a number greater than the base"
+ (make-timespec (time hour: 01 minute: 00 second: 00) '- #\w)
+ (timespec-add (make-timespec (time hour: 10 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 11 minute: 00 second: 00) '- #\w)))
+
+ (test-equal "x + -x = 0"
+ (timespec-zero) (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w)
+ (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w))))
+
+ (test-group "- +"
+ (test-equal "Add a number less than the (negative) base"
+ (make-timespec (time hour: 10 minute: 00 second: 00) '+ #\w)
+ (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w)
+ (make-timespec (time hour: 00 minute: 20 second: 30) '+ #\w)))
+
+ (test-equal "Add a number greater than the (negative) base"
+ (make-timespec (time hour: 01 minute: 00 second: 00) '- #\w)
+ (timespec-add (make-timespec (time hour: 10 minute: 00 second: 00) '- #\w)
+ (make-timespec (time hour: 11 minute: 00 second: 00) '+ #\w)))
+
+ (test-equal "-x + x = 0"
+ (timespec-zero) (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w)
+ (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w))))
+
+ (test-group "+ +"
+ (test-equal "x + x = 2x"
+ (make-timespec (time hour: 20 minute: 41 second: 00) '+ #\w)
+ (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w)
+ (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w))))
+
+ (test-group "- -"
+ (test-equal "-x + -x = -2x"
+ (make-timespec (time hour: 20 minute: 41 second: 00) '- #\w)
+ (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w)
+ (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w))))
+
+ ;; add more than two timespecs
+
+ ;; add timespecs of differing types
+ )
+
+(test-group "parse-time-spec"
+ ;; TODO what even is this case?
+ (test-equal (make-timespec (time) '+ #\g) (parse-time-spec "-g"))
+
+ (test-equal "Parse direct date, with hour minute and second"
+ (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\w)
+ (parse-time-spec "20:00:00"))
+ (test-equal "Parse direct date, with hour and minute"
+ (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\w)
+ (parse-time-spec "20:00"))
+ (test-equal "Parse direct date, with just hour"
+ (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\w)
+ (parse-time-spec "20"))
+
+ (test-equal "Parse timespec with letter at end"
+ (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\g)
+ (parse-time-spec "20:00g"))
+
+ (test-equal "Parse negative timespec"
+ (make-timespec (time hour: 20 minute: 00 second: 00) '- #\w)
+ (parse-time-spec "-20"))
+
+ (test-equal "Parse negative timespec with letter at end"
+ (make-timespec (time hour: 20 minute: 00 second: 00) '- #\z)
+ (parse-time-spec "-20z")))
+
+'((datetime timespec))
diff --git a/tests/unit/datetime/tz.scm b/tests/unit/datetime/tz.scm
new file mode 100644
index 00000000..d335ced3
--- /dev/null
+++ b/tests/unit/datetime/tz.scm
@@ -0,0 +1,88 @@
+;;; Commentary:
+;; Tests that datetime->unix-time correctly converts between Olssen
+;; timezone definitions (e.g. Europe/Stockholm), into correct times
+;; and offsets (in unix time).
+;; Also indirectly tests the Zone Info Compiler (datetime zic), since
+;; the zoneinfo comes from there.
+;;; Code:
+
+(define-module (test tz)
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-88)
+ :use-module ((datetime)
+ :select (parse-ics-datetime
+ datetime
+ date
+ time
+ datetime->unix-time
+ unix-time->datetime
+ get-datetime))
+ :use-module ((hnh util env) :select (let-env)))
+
+;; London alternates between +0000 and +0100
+(let-env
+ ((TZ "Europe/London"))
+ (test-equal
+ "London winter"
+ (datetime year: 2020 month: 01 day: 12 hour: 13 minute: 30 second: 00)
+ (get-datetime
+ (parse-ics-datetime "20200112T133000Z")))
+ (test-equal
+ "London summer"
+ (datetime year: 2020 month: 06 day: 12 hour: 14 minute: 30 second: 00)
+ (get-datetime
+ (parse-ics-datetime "20200612T133000Z"))))
+
+;; Stockholm alternates between +0100 and +0200
+(let-env
+ ((TZ "Europe/Stockholm"))
+ (test-equal
+ "Stockholm winter"
+ (datetime year: 2020 month: 01 day: 12 hour: 14 minute: 30 second: 00)
+ (get-datetime
+ (parse-ics-datetime "20200112T133000Z")))
+ (test-equal
+ "Stockholm summer"
+ (datetime year: 2020 month: 06 day: 12 hour: 15 minute: 30 second: 00)
+ (get-datetime
+ (parse-ics-datetime "20200612T133000Z"))))
+
+(test-equal
+ -10800
+ (datetime->unix-time
+ (parse-ics-datetime
+ "19700101T000000"
+ "Europe/Tallinn")))
+
+(test-equal
+ -3600
+ (datetime->unix-time
+ (parse-ics-datetime
+ "19700101T000000"
+ "Europe/Stockholm")))
+
+(test-equal
+ 0
+ (datetime->unix-time
+ (parse-ics-datetime "19700101T000000Z")))
+
+;; yes, really
+(test-equal
+ -3600
+ (datetime->unix-time
+ (parse-ics-datetime
+ "19700101T000000"
+ "Europe/London")))
+
+(test-equal
+ (datetime
+ date:
+ (date year: 1970 month: 01 day: 01)
+ time:
+ (time hour: 00 minute: 00 second: 00)
+ tz:
+ "UTC")
+ (unix-time->datetime 0))
+
+
+'((datetime))
diff --git a/tests/unit/datetime/zic.scm b/tests/unit/datetime/zic.scm
new file mode 100644
index 00000000..19af169c
--- /dev/null
+++ b/tests/unit/datetime/zic.scm
@@ -0,0 +1,319 @@
+(define-module (test zic)
+ :use-module ((srfi srfi-1) :select (every))
+ :use-module (srfi srfi-64)
+ :use-module (srfi srfi-88)
+ :use-module (datetime)
+ :use-module (datetime timespec)
+ :use-module (datetime zic))
+
+
+(test-expect-fail "Simple Leap")
+(test-expect-fail "Simple Expire")
+
+(define big-sample
+ "# Rule NAME FROM TO - IN ON AT SAVE LETTER/S
+Rule Swiss 1941 1942 - May Mon>=1 1:00 1:00 S
+Rule Swiss 1941 1942 - Oct Mon>=1 2:00 0 -
+Rule EU 1977 1980 - Apr Sun>=1 1:00u 1:00 S
+Rule EU 1977 only - Sep lastSun 1:00u 0 -
+Rule EU 1978 only - Oct 1 1:00u 0 -
+Rule EU 1979 1995 - Sep lastSun 1:00u 0 -
+Rule EU 1981 max - Mar lastSun 1:00u 1:00 S
+Rule EU 1996 max - Oct lastSun 1:00u 0 -
+
+# Zone NAME STDOFF RULES FORMAT [UNTIL]
+Zone Europe/Zurich 0:34:08 - LMT 1853 Jul 16
+ 0:29:45.50 - BMT 1894 Jun
+ 1:00 Swiss CE%sT 1981
+ 1:00 EU CE%sT
+
+Link Europe/Zurich Europe/Vaduz
+")
+
+(define parse-zic-file (@@ (datetime zic) parse-zic-file))
+
+;; Some of the tests are slightly altered to score better on the coverage
+(test-group "From zic(8)"
+ (test-equal "Basic Rule"
+ (list ((@@ (datetime zic) make-rule)
+ 'US 1967 1973 4 '(last 0)
+ ((@ (datetime zic) make-timespec) (time hour: 02 minute: 00 second: 00) '+ #\w)
+ ((@ (datetime zic) make-timespec) (time hour: 01 minute: 00 second: 00) '+ #\d)
+ "D"))
+ (call-with-input-string "Rule US 1967 1973 - Apr lastSun 2:00w 1:00d D"
+ parse-zic-file))
+
+ ;; Technically not from zic(8), since that example has an until field
+ (test-equal "Basic Zone"
+ (list ((@@ (datetime zic) make-zone) "Asia/Amman"
+ (list ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ 'Jordan "EE%sT" #f))))
+
+ (call-with-input-string
+ "Zone Asia/Amman 2:00 Jordan EE%sT"
+ parse-zic-file))
+
+ ;; Modified from the following example
+ (test-equal "Basic Zone with continuation"
+ (list ((@@ (datetime zic) make-zone) "America/Menominee"
+ (list ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 05 minute: 00 second: 00) '- #\w)
+ #f "EST" (datetime year: 1973 month: 04 day: 29 hour: 02 minute: 00 second: 00))
+ ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 06 minute: 00 second: 00) '- #\w)
+ 'US "C%sT" #f))))
+ ;; Why can't I single read a zone with an until field?
+ (call-with-input-string
+ "Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
+ -6:00 US C%sT"
+ parse-zic-file))
+
+
+ (test-equal "Rules and Zone"
+ (list ((@@ (datetime zic) make-zone) "America/Menominee"
+ (list ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 05 minute: 00 second: 00) '- #\w)
+ #f "EST" (datetime year: 1973 month: 04 day: 29 hour: 02 minute: 00 second: 00))
+ ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 06 minute: 00 second: 00) '- #\w)
+ 'US "C%sT" #f)))
+ ((@@ (datetime zic) make-rule)
+ 'US 1967 1973 dec '(last 0)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ "D")
+ ((@@ (datetime zic) make-rule)
+ 'US 1967 2006 nov '(last 0)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "S"))
+ (call-with-input-string
+ "# Rule NAME FROM TO - IN ON AT SAVE LETTER/S
+Rule US 1967 2006 - Nov lastSun 2:00 0 S
+Rule US 1967 1973 - Dec lastSun 2:00 1:00 D
+# Zone NAME STDOFF RULES FORMAT [UNTIL]
+Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00
+ -6:00 US C%sT
+" parse-zic-file))
+
+
+ (test-equal "Simple Link"
+ (list ((@@ (datetime zic) make-link) "Asia/Istanbul" "Europe/Istanbul"))
+ (call-with-input-string "Link Europe/Istanbul Asia/Istanbul"
+ parse-zic-file))
+
+ (test-equal "Simple Leap"
+ 'not-yet-implemented
+ (call-with-input-string "Leap 2016 Dec 31 23:59:60 + S"
+ parse-zic-file))
+
+ (test-equal "Simple Expire"
+ 'not-yet-implemented
+ (call-with-input-string "Expires 2020 Dec 28 00:00:00"
+ parse-zic-file))
+
+
+ (test-equal "Extended example"
+ ;; Items are in reverse order of discovery
+ (list ((@@ (datetime zic) make-link) "Europe/Vaduz" "Europe/Zurich")
+ ((@@ (datetime zic) make-zone) "Europe/Zurich"
+ (list ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 00 minute: 34 second: 08) '+ #\w)
+ #f "LMT" (datetime year: 1853 month: 07 day: 16 hour: 00 minute: 00 second: 00))
+ ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 00 minute: 29 second: 45) '+ #\w) ; NOTE that the .50 is discarded
+ #f "BMT" (datetime year: 1894 month: 06 day: 01 hour: 00 minute: 00 second: 00))
+ ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ 'Swiss "CE%sT" (datetime year: 1981 month: 01 day: 01 hour: 00 minute: 00 second: 00))
+ ((@@ (datetime zic) make-zone-entry)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ 'EU "CE%sT" #f)))
+ ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 '(last 0)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")
+ ((@@ (datetime zic) make-rule) 'EU 1981 'maximum 3 '(last 0)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ "S")
+ ((@@ (datetime zic) make-rule) 'EU 1979 1995 9 `(last ,sun)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")
+ ((@@ (datetime zic) make-rule) 'EU 1978 'only 10 1
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")
+ ((@@ (datetime zic) make-rule) 'EU 1977 'only 9 `(last ,sun)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")
+ ((@@ (datetime zic) make-rule) 'EU 1977 1980 4 `(> ,sun 1)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ "S")
+ ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 10 `(> ,mon 1)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")
+ ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 5 `(> ,mon 1)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ "S"))
+ (call-with-input-string big-sample
+ parse-zic-file)))
+
+(test-group "rule->dtstart"
+ (test-equal "last sunday"
+ (datetime year: 1967 month: 04 day: 30 hour: 02 minute: 00 second: 00)
+ (rule->dtstart
+ ((@@ (datetime zic) make-rule)
+ 'US 1967 1973 4 '(last 0)
+ ((@ (datetime zic) make-timespec) (time hour: 02 minute: 00 second: 00) '+ #\w)
+ ((@ (datetime zic) make-timespec) (time hour: 01 minute: 00 second: 00) '+ #\d)
+ "D")))
+
+ (test-equal "sunday >= 1"
+ (datetime year: 1977 month: 04 day: 03 hour: 01 minute: 00 second: 00 tz: "UTC")
+ (rule->dtstart
+ ((@@ (datetime zic) make-rule) 'EU 1977 1980 4 `(> ,sun 1)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ "S")))
+
+ ;; Max and min uses dummy dates, which is slightly wrong
+ ;; but shouldn't cause any real problems
+
+ (test-equal "Minimum time"
+ (datetime year: 0000 month: 10 day: 30 hour: 01 minute: 00 second: 00 tz: "UTC")
+ (rule->dtstart
+ ((@@ (datetime zic) make-rule) 'EU 'minimum 2000 10 '(last 0)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+
+ (test-equal "Maximum time"
+ (datetime year: 9999 month: oct day: 27
+ hour: 1 tz: "UTC")
+ (rule->dtstart
+ ((@@ (datetime zic) make-rule) 'EU 'maximum 2000 10 '(last 0)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ ""))))
+
+(test-group "zone-format"
+
+ (test-equal "Zone format with argument" "CEST" (zone-format "CE%sT" "S"))
+ (test-equal "Zone format with empty" "CET" (zone-format "CE%sT" ""))
+
+ ;; TODO zone-format %z is not yet implemented, and therefore untested
+
+ ;; TODO this error message is currently translatable...
+ (test-equal "Invalid format specifier"
+ '(misc-error "zone-format" "Invalid format char ~s in ~s at position ~a" (#\S "%S" 1) #f)
+ (catch 'misc-error (lambda () (zone-format "%S" "A"))
+ list)))
+
+(test-group "Actual object"
+ ;; NOTE this doesn't test read-zoneinfos ability to
+ ;; - take filenames
+ ;; - take multiple items
+ (let ((zoneinfo (call-with-input-string big-sample (compose read-zoneinfo list))))
+ (test-assert "get-zone returns a zone-entry object"
+ (every zone-entry? (get-zone zoneinfo "Europe/Zurich")))
+ (test-equal "A link resolves to the same object as its target"
+ (get-zone zoneinfo "Europe/Zurich") (get-zone zoneinfo "Europe/Vaduz"))
+ (test-equal "Get rules returns correctly, and in order"
+ ;; Rules are sorted
+ (list ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 5 `(> ,mon 1)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w)
+ "S")
+ ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 10 `(> ,mon 1)
+ (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ ""))
+ (get-rule zoneinfo 'Swiss))))
+
+
+(test-group "rule->rrule"
+ (test-equal "Basic example, and to = maximum"
+ ((@ (vcomponent recurrence internal) make-recur-rule)
+ freq: 'YEARLY interval: 1 wkst: mon
+ byday: (list (cons -1 sun))
+ bymonth: (list oct))
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 '(last 0)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")
+ ))
+
+ (test-equal "with to = only"
+ #f
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 'only 10 '(last 2)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+
+ (test-equal "with definitive to year"
+ ((@ (vcomponent recurrence internal) make-recur-rule)
+ freq: 'YEARLY interval: 1 wkst: mon
+ byday: (list (cons -1 tue))
+ bymonth: (list oct)
+ until: (datetime year: 2000 month: 01 day: 01 hour: 00 minute: 00 second: 00))
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 2000 10 '(last 2)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+
+ (test-equal "on being a month day"
+ ((@ (vcomponent recurrence internal) make-recur-rule)
+ freq: 'YEARLY interval: 1 wkst: mon
+ bymonthday: (list 2)
+ bymonth: (list oct))
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 2
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+
+ (test-equal "on being first day after date"
+ ((@ (vcomponent recurrence internal) make-recur-rule)
+ freq: 'YEARLY interval: 1 wkst: mon
+ byday: (list (cons 1 mon))
+ bymonth: (list oct))
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 `(> ,mon 2)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+
+ (test-equal "Crash on counting backwards from date"
+ '(misc-error "rule->rrule" "Counting backward for RRULES unsupported" #f #f)
+ (catch 'misc-error
+ (lambda ()
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 `(< ,mon 2)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+ list))
+
+ (test-equal "Crash on to = minimum"
+ '(misc-error "rule->rrule" "Check your input" #f #f)
+ (catch 'misc-error
+ (lambda ()
+ (rule->rrule
+ ((@@ (datetime zic) make-rule) 'EU 1996 'minimum 10 `(< ,mon 2)
+ (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u)
+ (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w)
+ "")))
+ list))
+ )
+
+'((datetime zic))
generated by cgit v1.2.3 (git 2.25.1) at 2024-06-29 12:30:31 +0200