From f7716ac1a87649cad96242f2d5bf0a987d7f430c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 7 Mar 2022 15:31:00 +0100 Subject: Add new tests. --- tests/annoying-events.scm | 59 -- tests/base64.scm | 23 - tests/cpp.scm | 43 - tests/datetime-compare.scm | 83 -- tests/datetime-util.scm | 92 -- tests/datetime.scm | 246 ----- tests/let-env.scm | 22 - tests/let.scm | 20 - tests/param.scm | 39 - tests/recurrence-advanced.scm | 1170 -------------------- tests/recurrence-simple.scm | 287 ----- tests/rrule-serialization.scm | 76 -- tests/run-tests.scm | 242 ++--- tests/server.scm | 21 - tests/srfi-41-util.scm | 40 - tests/termios.scm | 37 - tests/test/annoying-events.scm | 75 ++ tests/test/base64.scm | 24 + tests/test/cpp.scm | 39 + tests/test/datetime-compare.scm | 145 +++ tests/test/datetime-util.scm | 182 ++++ tests/test/datetime.scm | 395 +++++++ tests/test/let-env.scm | 42 + tests/test/let.scm | 45 + tests/test/param.scm | 57 + tests/test/recurrence-advanced.scm | 1347 ++++++++++++++++++++++++ tests/test/recurrence-simple.scm | 296 ++++++ tests/test/rrule-serialization.scm | 75 ++ tests/test/server.scm | 24 + tests/test/srfi-41-util.scm | 44 + tests/test/termios.scm | 48 + tests/test/tz.scm | 87 ++ tests/test/util.scm | 145 +++ tests/test/vcomponent-control.scm | 36 + tests/test/vcomponent-datetime.scm | 49 + tests/test/vcomponent-formats-common-types.scm | 137 +++ tests/test/vcomponent.scm | 23 + tests/test/web-server.scm | 116 ++ tests/test/xcal.scm | 58 + tests/test/xml-namespace.scm | 36 + tests/tz.scm | 57 - tests/util.scm | 81 -- tests/vcomponent-control.scm | 29 - tests/vcomponent-datetime.scm | 40 - tests/vcomponent-formats-common-types.scm | 115 -- tests/vcomponent.scm | 16 - tests/web-server.scm | 61 -- tests/xcal.scm | 50 - tests/xml-namespace.scm | 30 - 49 files changed, 3611 insertions(+), 2893 deletions(-) delete mode 100644 tests/annoying-events.scm delete mode 100644 tests/base64.scm delete mode 100644 tests/cpp.scm delete mode 100644 tests/datetime-compare.scm delete mode 100644 tests/datetime-util.scm delete mode 100644 tests/datetime.scm delete mode 100644 tests/let-env.scm delete mode 100644 tests/let.scm delete mode 100644 tests/param.scm delete mode 100644 tests/recurrence-advanced.scm delete mode 100644 tests/recurrence-simple.scm delete mode 100644 tests/rrule-serialization.scm delete mode 100644 tests/server.scm delete mode 100644 tests/srfi-41-util.scm delete mode 100644 tests/termios.scm create mode 100644 tests/test/annoying-events.scm create mode 100644 tests/test/base64.scm create mode 100644 tests/test/cpp.scm create mode 100644 tests/test/datetime-compare.scm create mode 100644 tests/test/datetime-util.scm create mode 100644 tests/test/datetime.scm create mode 100644 tests/test/let-env.scm create mode 100644 tests/test/let.scm create mode 100644 tests/test/param.scm create mode 100644 tests/test/recurrence-advanced.scm create mode 100644 tests/test/recurrence-simple.scm create mode 100644 tests/test/rrule-serialization.scm create mode 100644 tests/test/server.scm create mode 100644 tests/test/srfi-41-util.scm create mode 100644 tests/test/termios.scm create mode 100644 tests/test/tz.scm create mode 100644 tests/test/util.scm create mode 100644 tests/test/vcomponent-control.scm create mode 100644 tests/test/vcomponent-datetime.scm create mode 100644 tests/test/vcomponent-formats-common-types.scm create mode 100644 tests/test/vcomponent.scm create mode 100644 tests/test/web-server.scm create mode 100644 tests/test/xcal.scm create mode 100644 tests/test/xml-namespace.scm delete mode 100644 tests/tz.scm delete mode 100644 tests/util.scm delete mode 100644 tests/vcomponent-control.scm delete mode 100644 tests/vcomponent-datetime.scm delete mode 100644 tests/vcomponent-formats-common-types.scm delete mode 100644 tests/vcomponent.scm delete mode 100644 tests/web-server.scm delete mode 100644 tests/xcal.scm delete mode 100644 tests/xml-namespace.scm (limited to 'tests') diff --git a/tests/annoying-events.scm b/tests/annoying-events.scm deleted file mode 100644 index 90e6a184..00000000 --- a/tests/annoying-events.scm +++ /dev/null @@ -1,59 +0,0 @@ -(((srfi srfi-41 util) filter-sorted-stream) - ((srfi srfi-41) stream stream->list stream-filter stream-take-while) - ((vcomponent base) extract prop make-vcomponent) - ((vcomponent datetime) event-overlaps?) - ((datetime) date date+ date<) - ((hnh util) set!)) - -(define* (event key: summary dtstart dtend) - (define ev (make-vcomponent 'VEVENT)) - (set! (prop ev 'SUMMARY) summary - (prop ev 'DTSTART) dtstart - (prop ev 'DTEND) dtend) - ev) - -(define start #2021-11-01) -(define end (date+ start (date day: 8))) - -(define ev-set - (stream - (event ; should be part of the result - summary: "A" - dtstart: #2021-10-01 - dtend: #2021-12-01) - (event ; should NOT be part of the result - summary: "B" - dtstart: #2021-10-10 - dtend: #2021-10-11) - (event ; should also be part of the result - summary: "C" - dtstart: #2021-11-02 - dtend: #2021-11-03))) - -;; (if (and (date< (prop ev 'DTSTART) start-date) -;; (date<= (prop ev 'DTEND) end-date)) -;; ;; event will be picked, but next event might have -;; (and (date< start-date (prop ev 'DTSTART)) -;; (date< end-date (prop ev 'DTEND))) -;; ;; meaning that it wont be added, stopping filter-sorted-stream -;; ) - -;; The naïve way to get all events in an interval. Misses C due to B being "in the way" - -(test-equal "incorrect handling of non-contigious" - '("A" #; "C") - (map (extract 'SUMMARY) - (stream->list - (filter-sorted-stream - (lambda (ev) (event-overlaps? ev start (date+ start (date day: 8)))) - ev-set)))) - -;; A correct way - -(test-equal "correct handling of non-contigious" - '("A" "C") - (map (extract 'SUMMARY) - (stream->list - (stream-filter (lambda (ev) (event-overlaps? ev start end)) - (stream-take-while (lambda (ev) (date< (prop ev 'DTSTART) end)) - ev-set))))) diff --git a/tests/base64.scm b/tests/base64.scm deleted file mode 100644 index 59a8784c..00000000 --- a/tests/base64.scm +++ /dev/null @@ -1,23 +0,0 @@ -;;; Commentary: -;; Test that Base64 encoding and decoding works -;; Examples from RFC4648 -;;; Code: - -(((base64) base64encode base64decode)) - - -(test-equal "" (base64encode "")) -(test-equal "Zg==" (base64encode "f")) -(test-equal "Zm8=" (base64encode "fo")) -(test-equal "Zm9v" (base64encode "foo")) -(test-equal "Zm9vYg==" (base64encode "foob")) -(test-equal "Zm9vYmE=" (base64encode "fooba")) -(test-equal "Zm9vYmFy" (base64encode "foobar")) - -(test-equal "" (base64decode "")) -(test-equal "f" (base64decode "Zg==")) -(test-equal "fo" (base64decode "Zm8=")) -(test-equal "foo" (base64decode "Zm9v")) -(test-equal "foob" (base64decode "Zm9vYg==")) -(test-equal "fooba" (base64decode "Zm9vYmE=")) -(test-equal "foobar" (base64decode "Zm9vYmFy")) diff --git a/tests/cpp.scm b/tests/cpp.scm deleted file mode 100644 index 84bd4b92..00000000 --- a/tests/cpp.scm +++ /dev/null @@ -1,43 +0,0 @@ -;;; Commentary: -;; Tests my parser for a subset of the C programming language. -;;; Code: - -(((c lex) lex) - ((c parse) parse-lexeme-tree)) - -(define run (compose parse-lexeme-tree lex)) - -(test-equal - '(+ (post-increment (dereference C)) 3) - (run "(*C)++ + 3")) - - -(test-equal - '(+ (post-increment (dereference C)) 3) - (run "*C++ + 3")) - -(test-equal - '(post-increment (dereference C)) - (run "*C++")) - -(test-equal - '(+ (post-increment C) (post-increment C)) - (run "C++ + C++")) - -(test-equal - '(+ (pre-increment C) (pre-increment C)) - (run "++C + ++C")) - - -(test-equal - '(+ 2 (* 2 2)) - (run "2 + 2 * 2")) - -(test-equal - '(+ (* 2 2) 2) - (run "2 * 2 + 2")) - -(test-equal - '(+ 2 2 2) - (run "2+2+2")) - diff --git a/tests/datetime-compare.scm b/tests/datetime-compare.scm deleted file mode 100644 index f2585f46..00000000 --- a/tests/datetime-compare.scm +++ /dev/null @@ -1,83 +0,0 @@ -;;; Commentary: -;; Tests that all ordering predicates for dates, -;; times, and datetimes hold. -;;; Code: - -(((datetime) - date - datetime time - date< date<= - date> date>= - date/-time< - time< - )) - -(test-assert "date< empty" - (date<)) - -(test-assert "date< single" - (date< #2020-01-10)) - -(test-assert "date< double" - (date< #2020-01-10 #2020-01-11)) - -(test-assert "date< tripple" - (date< #2020-01-10 #2020-01-11 #2020-01-12)) - -(test-assert "date< tripple negate" - (not (date< #2020-01-10 #2020-01-12 #2020-01-11))) - -(test-assert "date<= empty" - (date<=)) - -(test-assert "date<= single" - (date<= #2020-01-10)) - -(test-assert "date<= double" - (date<= #2020-01-10 #2020-01-11)) - -(test-assert "date<=" - (not (date<= #2020-01-01 #2018-05-15 #2020-01-31))) - -(test-assert "date<= equal" - (date<= #2018-05-15 #2018-05-15)) - -(test-assert "date<" - (not (date< #2020-01-01 #2018-05-15 #2020-01-31))) - -(test-assert "date>" - (not (date> #2020-01-31 #2018-05-15 #2020-01-01 ))) - -(test-assert "date>=" - (not (date>= #2020-01-31 #2018-05-15 #2020-01-01))) - -(test-assert "time< simple" - (time< #05:00:00 #10:00:00)) - -(test-assert "time<" - (time< (time) #10:00:00)) - -(test-assert "date/-time<" - (date/-time< #2020-01-01 #2020-01-02)) - -(test-assert "not date/-time<" - (not (date/-time< #2020-01-01 #2020-01-01))) - -(test-assert "date/-time< only other dt" - (date/-time< #2020-01-01 #2020-01-02T10:00:00)) - -(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)) - -(test-assert (not (date/-time< #2018-11-30T08:10:00 #2014-04-13T16:00:00))) - - diff --git a/tests/datetime-util.scm b/tests/datetime-util.scm deleted file mode 100644 index 28317676..00000000 --- a/tests/datetime-util.scm +++ /dev/null @@ -1,92 +0,0 @@ -;;; Commentary: -;; Tests timespan overlaps and month-streams. -;; Separate from tests/datetime.scm since -;; (datetime util) originally was its own module. -;;; Code: - -(((datetime) date time datetime - month-stream in-date-range? timespan-overlaps?) - ((srfi srfi-41) stream->list stream-take - )) - -(test-assert "jan->dec" - (stream->list (stream-take 11 (month-stream #2020-01-01)))) - -(test-assert "dec->jan" - (stream->list (stream-take 2 (month-stream #2020-12-01)))) - -(test-assert "dec->feb" - (stream->list (stream-take 3 (month-stream #2020-12-01)))) - -(test-assert "20 months" - (stream->list (stream-take 20 (month-stream #2020-01-01)))) - -(test-equal "Correct months" - (list #2020-02-01 #2020-03-01 #2020-04-01 #2020-05-01 #2020-06-01 #2020-07-01 #2020-08-01 #2020-09-01 #2020-10-01 #2020-11-01 #2020-12-01 #2021-01-01) - - (stream->list (stream-take 12 (month-stream #2020-02-01)))) - -(test-assert "in-date-range?" - (not ((in-date-range? #2020-01-01 #2020-02-29) - #2018-02-02))) - - - - -(test-assert "A" - (timespan-overlaps? #2020-01-01 #2020-01-10 - #2020-01-05 #2020-01-15)) - -(test-assert "A, shared start" - (timespan-overlaps? #2020-01-01 #2020-01-10 - #2020-01-01 #2020-01-15)) - -(test-assert "A, tangential" - (not (timespan-overlaps? #2020-01-01T00:00:00 #2020-01-10T00:00:00 - #2020-01-10T00:00:00 #2020-01-30T00:00:00))) - - - -(test-assert "s1 instant" - (timespan-overlaps? #2020-01-15T10:00:00 #2020-01-15T10:00:00 - #2020-01-10T00:00:00 #2020-01-30T00:00:00)) - -(test-assert "s2 instant" - (timespan-overlaps? #2020-01-10T00:00:00 #2020-01-30T00:00:00 - #2020-01-15T10:00:00 #2020-01-15T10:00:00)) - -(test-assert "s1 instant, shared start with s2" - (timespan-overlaps? #2020-01-15T10:00:00 #2020-01-15T10:00:00 - #2020-01-15T10:00:00 #2020-01-30T00:00:00)) - - -(test-assert "s1 instant, shared end with s2" - (not (timespan-overlaps? #2020-01-15T10:00:00 #2020-01-15T10:00:00 - #2020-01-10T00:00:00 #2020-01-15T10:00:00))) - -(test-assert "s2 instant, shared start with s1" - (timespan-overlaps? #2020-01-15T10:00:00 #2020-01-30T00:00:00 - #2020-01-15T10:00:00 #2020-01-15T10:00:00)) - - -(test-assert "s2 instant, shared end with s1" - (not (timespan-overlaps? #2020-01-10T00:00:00 #2020-01-15T10:00:00 - #2020-01-15T10:00:00 #2020-01-15T10:00:00))) - - -(test-assert "both instant" - (not (timespan-overlaps? #2020-01-15T10:00:00 #2020-01-15T10:00:00 - #2020-01-15T10:00:00 #2020-01-15T10:00:00))) - -(test-assert "tangential whole day" - (not (timespan-overlaps? #2020-01-01 #2020-01-02 - #2020-01-02 #2020-01-03))) - -(test-assert "B" - (timespan-overlaps? #2020-01-05 #2020-01-15 - #2020-01-01 #2020-01-10)) - - -(test-assert "E" - (timespan-overlaps? #2020-01-01 #2020-01-10 - #2020-01-01 #2020-01-10)) diff --git a/tests/datetime.scm b/tests/datetime.scm deleted file mode 100644 index 6da385e2..00000000 --- a/tests/datetime.scm +++ /dev/null @@ -1,246 +0,0 @@ -;;; Commentary: -;; Tests date, time, and datetime creation, -;; (output) formatting, and arithmetic. -;;; Code: - -(((datetime) date+ date- - time+ time- - year month day - date time - datetime - datetime+ - datetime<=? - datetime-difference - datetime- - leap-year? - string->date string->time string->datetime - parse-month - days-in-interval - ) - ((ice-9 format) format) - ((hnh util) let*) - ((ice-9 i18n) make-locale) - ((guile) LC_TIME) - ) - -(test-equal "empty time" - (time) #00:00:00) - -(test-assert "Synatx date" - #2020-01-01) - -(test-assert "Test year type" - (integer? (year (date year: 2020)))) - -(test-assert "Test mmnth type" - (integer? (month (date month: 1)))) - -(test-assert "Test day type" - (integer? (day (date day: 1)))) - -(test-equal "Manual print (any)" - "2020-10-10" - (let ((d (date year: 2020 month: 10 day: 10))) - (format #f "~a-~a-~a" - (year d) (month d) (day d)))) - -(test-equal "Manual print (number)" - "2020-10-10" - (let ((d (date year: 2020 month: 10 day: 10))) - (format #f "~d-~d-~d" - (year d) (month d) (day d)))) - -(test-equal "Date print" - "#2020-01-01" - (format #f "~a" (date year: 2020 month: 1 day: 1))) - -(test-equal "Syntax date=" - (date year: 2020 month: 1 day: 1) - #2020-01-01) - -(test-equal "Syntax time=" - (time hour: 13 minute: 37 second: 0) - #13:37:00) - -(test-equal "Syntax Datetime=" - (datetime year: 2020 month: 1 day: 1 hour: 13 minute: 37 second: 0) - #2020-01-01T13:37:00) - -(test-equal #2020-02-28 (date- #2020-03-05 (date day: 6))) -(test-equal #2020-02-29 (date- #2020-03-05 (date day: 5))) -(test-equal #2020-03-01 (date- #2020-03-05 (date day: 4))) - -(test-equal "date+ day" #2020-10-10 (date+ #2020-10-01 (date day: 9))) -(test-equal "date+ month" #2020-10-10 (date+ #2020-01-10 (date month: 9))) -(test-equal "date+ day/month" #2020-10-10 (date+ #2020-01-01 (date day: 9 month: 9))) -;; (test-equal "date+ year" #4040-10-10 (date+ #2020-10-10 (date year: 2020))) - -(test-assert "date+ first literal" (date+ #2020-01-01 (date day: 0))) -(test-assert "date+ second literal" (date+ (date year: 1 month: 1 day: 1) #0001-00-00)) -(test-assert "date+ both literal" (date+ #2020-01-01 #0000-00-00)) - -(test-equal "date+ year overflow" #2019-01-01 (date+ #2018-12-31 (date day: 1))) -(test-equal "date- year overflow" #2018-12-31 (date- #2019-01-01 (date day: 1))) - -;; (test-equal "date+ large" #4040-10-10 (date+ #2020-05-03 #2020-05-07)) - -(test-equal "date- large" #0001-01-01 (date- #2020-01-01 #2019-00-00)) - -;; Datum är spännande -(test-equal "date- equal" (date year: -1 month: 11 day: 31) - (date- #2020-01-01 #2020-01-01)) - -(test-equal #2020-01-01T10:00:00 (datetime date: #2020-01-01 - time: #10:00:00)) -(test-equal #2020-01-01T10:00:00 - (datetime+ (datetime date: #2020-01-01) - (datetime time: #10:00:00))) - -(test-equal - #2020-10-09T14:00:00 - (datetime- #2020-10-10T00:00:00 - (datetime time: #10:00:00))) - -(test-equal - #2020-09-24T14:00:00 - (datetime- #2020-10-10T00:00:00 - #0000-00-15T10:00:00)) - - -(test-equal #2020-03-10 - (date+ #2020-03-01 - (date day: 4) - (date day: 5))) - - -(let* ((diff overflow (time- #10:20:30 #10:20:30))) - (test-equal "time- self" #00:00:00 diff) - (test-equal "time- self overflow" 0 overflow)) - -(let* ((diff overflow (time- #10:00:00 #10:00:01))) - (test-equal "time- overflow 1s" #23:59:59 diff) - (test-equal "time- overflow 1s overflow" 1 overflow)) - - -(let* ((diff overflow (time- #10:00:00 (time hour: (+ 48 4))))) - (test-equal "time- overflow multiple" #06:00:00 diff) - (test-equal "time- overflow multiple overflow" 2 overflow)) - -(test-equal "datetime-difference self" - #0000-00-00T00:00:00 - (datetime-difference (datetime date: #2020-01-01) (datetime date: #2020-01-01))) - -;; (test-assert -;; (datetime- #2018-01-17T10:00:00 -;; #2018-01-17T08:00:00)) - - -;; (test-assert -;; (datetime<=? (datetime time: (time hour: 24)) -;; (datetime- #2018-01-17T10:00:00 -;; #2018-01-17T08:00:00))) - - -;; NOTE -;; at the time of writing this returns #2020-02-00 -;; The general question is, how is the last in a month handled? -(test-equal - #2020-01-31 - (date+ #2019-12-31 (date month: 1))) - -(test-assert (leap-year? 2020)) - -(test-equal "Add to Leap day" - #2020-02-29 (date+ #2020-02-28 (date day: 1))) - - -(test-equal "Parse ISO" - #2021-12-30T13:53:33 - (string->datetime "2021-12-30T13:53:33" "~Y-~m-~dT~H:~M:~S")) - -(test-equal "Parse ical date-time" - #2021-12-30T13:53:33 - (string->datetime "20211230T135333" "~Y~m~dT~H~M~S")) - - -(test-equal "Parse single hour (padded)" - (time hour: 5) - (string->time "05" "~H")) - -(test-equal "Parse single hour (non-padded)" - (time hour: 5) - (string->time "5" "~H")) - -(test-equal "Parse month (swedish)" - (date month: 5) - (string->date "Maj" "~b" (make-locale LC_TIME "sv_SE.UTF-8"))) - -(test-equal "Parse month (english)" - (date month: 5) - (string->date "May" "~b" (make-locale LC_TIME "en_US.UTF-8"))) - -(test-equal "AM/PM AM" - (time hour: 10) - (string->time "10 AM" "~H ~p")) - -(test-equal "AM/PM PM" - (time hour: 22) - (string->time "10 PM" "~H ~p")) - -(test-equal "AM/PM AM 12" - (time hour: 0) - (string->time "12 AM" "~H ~p")) - -(test-equal "AM/PM PM 12" - (time hour: 12) - (string->time "12 PM" "~H ~p")) - -(test-equal "AM/PM PM (prefix)" - (time hour: 22) - (string->time "PM 10" "~p ~H")) - -(test-equal "Parse complicated 1" - #2021-12-30T10:56:00 - (string->datetime "Dec. 30, 2021, 10:56" - "~b. ~d, ~Y, ~H:~M" - (make-locale LC_TIME "en_US.UTF-8"))) - -(test-equal "Parse complicated 2" - #2021-12-30T10:56:00 - (string->datetime "Dec. 30, 2021, 10:56 a.m." - "~b. ~d, ~Y, ~H:~M" - (make-locale LC_TIME "en_US.UTF-8"))) - -(test-equal "Parse complicated 3" - #2021-12-30T22:56:00 - (string->datetime "Dec. 30, 2021, 10:56 p.m." - "~b. ~d, ~Y, ~H:~M ~p" - (make-locale LC_TIME "en_US.UTF-8"))) - -(test-equal "Parse date single digit day" - (date day: 6) - (string->date "6" "~d")) - -(test-equal "Parse date single digit day, trailing comma" - (date day: 6) - (string->date "6," "~d,")) - -(test-equal "Parse date single digit day, trailing comma + space" - (date day: 6) - (string->date "6, " "~d, ")) - - -(define en_US (make-locale LC_TIME "en_US.UTF-8")) -(define sv_SE (make-locale LC_TIME "sv_SE.UTF-8")) - -(test-equal 1 (parse-month "jan" en_US)) -(test-equal 1 (parse-month "jan" sv_SE)) - -(test-equal 12 (parse-month "dec" en_US)) -(test-equal -1 (parse-month "inv" en_US)) - -(test-equal 5 (parse-month "mAJ" sv_SE)) - - -(test-equal "Days in regular year" 365 (days-in-interval #2021-01-01 #2021-12-31)) -(test-equal "Days in leap year" 366 (days-in-interval #2020-01-01 #2020-12-31)) diff --git a/tests/let-env.scm b/tests/let-env.scm deleted file mode 100644 index 17cfb817..00000000 --- a/tests/let-env.scm +++ /dev/null @@ -1,22 +0,0 @@ -(((guile) setenv getenv) - ((hnh util) let-env)) - -(setenv "CALP_TEST_ENV" "1") -(test-equal "Ensure we have set value beforehand" - "1" (getenv "CALP_TEST_ENV")) -(let-env ((CALP_TEST_ENV "2")) - (test-equal "Test our local override" - "2" (getenv "CALP_TEST_ENV"))) -(test-equal "Test that we have returned" - "1" (getenv "CALP_TEST_ENV")) - -(catch 'test-error - (lambda () - (let-env ((CALP_TEST_ENV "2")) - (test-equal "Test our local override again" - "2" (getenv "CALP_TEST_ENV")) - (throw 'test-error))) - list) - -(test-equal "Test restoration after non-local exit" - "1" (getenv "CALP_TEST_ENV")) diff --git a/tests/let.scm b/tests/let.scm deleted file mode 100644 index 3f1b52a7..00000000 --- a/tests/let.scm +++ /dev/null @@ -1,20 +0,0 @@ -;;; Commentary: -;; Tests my custom let*. -;;; Code: - -(((hnh util) let*) - ((guile) set!)) - -(test-assert (let* ((a #t)) a)) -(test-assert (let* (((a . b) (cons #t #f))) a)) -(test-assert (let* (((a . b) (cons* #f #t))) b)) -(test-assert (let* ((a b c (values #f #t #f))) b)) -(test-assert (let* (((a b c) (list #f #t #f))) b)) -(test-assert (let* (((a) '(#t))) a)) -(test-equal '(2) (let* (((a . b) '(1 2))) b)) -(test-equal '(3 4) (let* (((a b . c) '(1 2 3 4))) c)) -(test-equal 10 (let* (x) (set! x 10) x)) -(test-equal 30 (let* (x y) (set! x 10) (set! y 20) (+ x y))) -(test-assert (let* (x) (not x))) -(test-equal 6 (let* ((x 1) y z) (set! y 2) (set! z 3) (+ x y z))) - diff --git a/tests/param.scm b/tests/param.scm deleted file mode 100644 index cf8c9458..00000000 --- a/tests/param.scm +++ /dev/null @@ -1,39 +0,0 @@ -;;; Commentary: -;; Checks that parameters (1) are correctly parsed and stored. -;; (1): 'A', and 'B' in the line "KEY;A=1;B=2:Some text" -;;; Code: - -(((vcomponent base) param prop* parameters prop) - ((vcomponent formats ical parse) parse-calendar) - ((vcomponent) make-vcomponent) - ((hnh util) sort* set!)) - -(define v (call-with-input-string - "BEGIN:DUMMY -X-KEY;A=1;B=2:Some text -END:DUMMY" - parse-calendar)) - -(test-equal '("1") (param (prop* v 'X-KEY) 'A)) -(test-equal '("2") (param (prop* v 'X-KEY) 'B)) -(test-equal #f (param (prop* v 'X-KEY) 'C)) - -(test-equal '(A B) (sort* (map car (parameters (prop* v 'X-KEY))) - stringstring)) - -;; TODO possibly move this. -;; Checks that a warning is properly raised for -;; unkonwn keys (without an X-prefix) -(test-error - 'warning - (call-with-input-string "BEGIN:DUMMY -KEY:Some Text -END:DUMMY")) - -;; Similar thing happens for sxcal, but during serialization instead -(let ((component (make-vcomponent 'DUMMY))) - (set! (prop component 'KEY) "Anything") - (test-error - 'warning - (vcomponent->sxcal component))) diff --git a/tests/recurrence-advanced.scm b/tests/recurrence-advanced.scm deleted file mode 100644 index 70312a2a..00000000 --- a/tests/recurrence-advanced.scm +++ /dev/null @@ -1,1170 +0,0 @@ -;;; Commentary: -;; Tests of recurrence rule generation with focus on correct instances -;; being generated. For tests of basic recurrence functionallity, see -;; recurrence-simple.scm. -;; -;; This file also tests format-recurrence-rule, which checks that human -;; readable representations of the RRULES work. -;; -;; Also contains the tests for EXDATE. -;; -;; Most examples copied from RFC5545, some home written. -;;; Code: - -;; The human readable tests are expected to fail with any change to the -;; text creator. Proof-read them manually, and update the test cases -;; to match. `x-summary' used for target string. Target strings should -;; be in swedish. - -(((vcomponent recurrence parse) parse-recurrence-rule) - ((vcomponent recurrence generate) generate-recurrence-set) - ((vcomponent recurrence display) format-recurrence-rule) - ((vcomponent recurrence internal) count until) - ((vcomponent base) make-vcomponent prop prop* extract) - ((datetime) parse-ics-datetime datetime time date - datetime->string) - ((hnh util) -> set!) - ((srfi srfi-41) stream->list) - ((srfi srfi-88) keyword->string)) - -(test-expect-fail "RSET: The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months") -(test-expect-fail "STR: The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months") -(test-expect-fail "RSET: The second-to-last weekday of the month") -(test-expect-fail "STR: The second-to-last weekday of the month") - -;; TODO this test is really slow, figure out why (takes approx. 25s to run) -(test-skip "RSET: Every day in January, for 3 years (alt 2)") - -(define (run-test comp) - - (test-equal (string-append "RSET: " (prop comp 'SUMMARY)) - (prop comp 'X-SET) - (let ((r (generate-recurrence-set comp))) - (map (extract 'DTSTART) - (if (or (until (prop comp 'RRULE)) - (count (prop comp 'RRULE))) - (stream->list r) - (stream->list 20 r))))) - - (test-equal (string-append "STR: " (prop comp 'SUMMARY)) - (prop comp 'X-SUMMARY) - (format-recurrence-rule (prop comp 'RRULE)))) - - -(define (vevent . rest) - (define v (make-vcomponent 'VEVENT)) - - (let loop ((rem rest)) - (unless (null? rem) - (let ((symb (-> (car rem) - keyword->string - string-upcase - string->symbol))) - (set! (prop v symb) - (case symb - [(DTSTART EXDATE) (parse-ics-datetime (cadr rem))] - [(RRULE) (parse-recurrence-rule (cadr rem))] - [else (cadr rem)])) - ;; hack for multi valued fields - (when (eq? symb 'EXDATE) - (set! (prop* v symb) = list))) - (loop (cddr rem)))) - - v) - -(map run-test - (list - (vevent - summary: "Daily for 10 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=DAILY;COUNT=10" - x-summary: "dagligen, totalt 10 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-03T09:00:00 - #1997-09-04T09:00:00 - #1997-09-05T09:00:00 - #1997-09-06T09:00:00 - #1997-09-07T09:00:00 - #1997-09-08T09:00:00 - #1997-09-09T09:00:00 - #1997-09-10T09:00:00 - #1997-09-11T09:00:00)) - - (vevent - summary: "Daily until December 24, 1997" - dtstart: "19970902T090000" - rrule: "FREQ=DAILY;UNTIL=19971224T000000Z" - x-summary: "dagligen, till och med den 24 december, 1997 kl. 0:00" - x-set: (list #1997-09-02T09:00:00 - #1997-09-03T09:00:00 - #1997-09-04T09:00:00 - #1997-09-05T09:00:00 - #1997-09-06T09:00:00 - #1997-09-07T09:00:00 - #1997-09-08T09:00:00 - #1997-09-09T09:00:00 - #1997-09-10T09:00:00 - #1997-09-11T09:00:00 - #1997-09-12T09:00:00 - #1997-09-13T09:00:00 - #1997-09-14T09:00:00 - #1997-09-15T09:00:00 - #1997-09-16T09:00:00 - #1997-09-17T09:00:00 - #1997-09-18T09:00:00 - #1997-09-19T09:00:00 - #1997-09-20T09:00:00 - #1997-09-21T09:00:00 - #1997-09-22T09:00:00 - #1997-09-23T09:00:00 - #1997-09-24T09:00:00 - #1997-09-25T09:00:00 - #1997-09-26T09:00:00 - #1997-09-27T09:00:00 - #1997-09-28T09:00:00 - #1997-09-29T09:00:00 - #1997-09-30T09:00:00 - #1997-10-01T09:00:00 - #1997-10-02T09:00:00 - #1997-10-03T09:00:00 - #1997-10-04T09:00:00 - #1997-10-05T09:00:00 - #1997-10-06T09:00:00 - #1997-10-07T09:00:00 - #1997-10-08T09:00:00 - #1997-10-09T09:00:00 - #1997-10-10T09:00:00 - #1997-10-11T09:00:00 - #1997-10-12T09:00:00 - #1997-10-13T09:00:00 - #1997-10-14T09:00:00 - #1997-10-15T09:00:00 - #1997-10-16T09:00:00 - #1997-10-17T09:00:00 - #1997-10-18T09:00:00 - #1997-10-19T09:00:00 - #1997-10-20T09:00:00 - #1997-10-21T09:00:00 - #1997-10-22T09:00:00 - #1997-10-23T09:00:00 - #1997-10-24T09:00:00 - #1997-10-25T09:00:00 - #1997-10-26T09:00:00 - #1997-10-27T09:00:00 - #1997-10-28T09:00:00 - #1997-10-29T09:00:00 - #1997-10-30T09:00:00 - #1997-10-31T09:00:00 - #1997-11-01T09:00:00 - #1997-11-02T09:00:00 - #1997-11-03T09:00:00 - #1997-11-04T09:00:00 - #1997-11-05T09:00:00 - #1997-11-06T09:00:00 - #1997-11-07T09:00:00 - #1997-11-08T09:00:00 - #1997-11-09T09:00:00 - #1997-11-10T09:00:00 - #1997-11-11T09:00:00 - #1997-11-12T09:00:00 - #1997-11-13T09:00:00 - #1997-11-14T09:00:00 - #1997-11-15T09:00:00 - #1997-11-16T09:00:00 - #1997-11-17T09:00:00 - #1997-11-18T09:00:00 - #1997-11-19T09:00:00 - #1997-11-20T09:00:00 - #1997-11-21T09:00:00 - #1997-11-22T09:00:00 - #1997-11-23T09:00:00 - #1997-11-24T09:00:00 - #1997-11-25T09:00:00 - #1997-11-26T09:00:00 - #1997-11-27T09:00:00 - #1997-11-28T09:00:00 - #1997-11-29T09:00:00 - #1997-11-30T09:00:00 - #1997-12-01T09:00:00 - #1997-12-02T09:00:00 - #1997-12-03T09:00:00 - #1997-12-04T09:00:00 - #1997-12-05T09:00:00 - #1997-12-06T09:00:00 - #1997-12-07T09:00:00 - #1997-12-08T09:00:00 - #1997-12-09T09:00:00 - #1997-12-10T09:00:00 - #1997-12-11T09:00:00 - #1997-12-12T09:00:00 - #1997-12-13T09:00:00 - #1997-12-14T09:00:00 - #1997-12-15T09:00:00 - #1997-12-16T09:00:00 - #1997-12-17T09:00:00 - #1997-12-18T09:00:00 - #1997-12-19T09:00:00 - #1997-12-20T09:00:00 - #1997-12-21T09:00:00 - #1997-12-22T09:00:00 - #1997-12-23T09:00:00 - ;; December 24 SHOULD be missing. - )) - - - (vevent - summary: "Every other day - forever" - dtstart: "19970902T090000" - rrule: "FREQ=DAILY;INTERVAL=2" - x-summary: "varannan dag" - x-set: (list #1997-09-02T09:00:00 - #1997-09-04T09:00:00 - #1997-09-06T09:00:00 - #1997-09-08T09:00:00 - #1997-09-10T09:00:00 - #1997-09-12T09:00:00 - #1997-09-14T09:00:00 - #1997-09-16T09:00:00 - #1997-09-18T09:00:00 - #1997-09-20T09:00:00 - #1997-09-22T09:00:00 - #1997-09-24T09:00:00 - #1997-09-26T09:00:00 - #1997-09-28T09:00:00 - #1997-09-30T09:00:00 - #1997-10-02T09:00:00 - #1997-10-04T09:00:00 - #1997-10-06T09:00:00 - #1997-10-08T09:00:00 - #1997-10-10T09:00:00)) - - (vevent - summary: "Every 10 days, 5 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=DAILY;INTERVAL=10;COUNT=5" - x-summary: "var tionde dag, totalt 5 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-12T09:00:00 - #1997-09-22T09:00:00 - #1997-10-02T09:00:00 - #1997-10-12T09:00:00)) - - (vevent - summary: "Every day in January, for 3 years (alt 1)" - dtstart: "19980101T090000" - rrule: "FREQ=YEARLY;UNTIL=20000131T140000Z;BYMONTH=1;BYDAY=SU,MO,TU,WE,TH,FR,SA" - x-summary: "varje lördag, fredag, torsdag, onsdag, tisdag, måndag & söndag i januari, årligen, till och med den 31 januari, 2000 kl. 14:00" - x-set: (list #1998-01-01T09:00:00 - #1998-01-02T09:00:00 - #1998-01-03T09:00:00 - #1998-01-04T09:00:00 - #1998-01-05T09:00:00 - #1998-01-06T09:00:00 - #1998-01-07T09:00:00 - #1998-01-08T09:00:00 - #1998-01-09T09:00:00 - #1998-01-10T09:00:00 - #1998-01-11T09:00:00 - #1998-01-12T09:00:00 - #1998-01-13T09:00:00 - #1998-01-14T09:00:00 - #1998-01-15T09:00:00 - #1998-01-16T09:00:00 - #1998-01-17T09:00:00 - #1998-01-18T09:00:00 - #1998-01-19T09:00:00 - #1998-01-20T09:00:00 - #1998-01-21T09:00:00 - #1998-01-22T09:00:00 - #1998-01-23T09:00:00 - #1998-01-24T09:00:00 - #1998-01-25T09:00:00 - #1998-01-26T09:00:00 - #1998-01-27T09:00:00 - #1998-01-28T09:00:00 - #1998-01-29T09:00:00 - #1998-01-30T09:00:00 - #1998-01-31T09:00:00 - #1999-01-01T09:00:00 - #1999-01-02T09:00:00 - #1999-01-03T09:00:00 - #1999-01-04T09:00:00 - #1999-01-05T09:00:00 - #1999-01-06T09:00:00 - #1999-01-07T09:00:00 - #1999-01-08T09:00:00 - #1999-01-09T09:00:00 - #1999-01-10T09:00:00 - #1999-01-11T09:00:00 - #1999-01-12T09:00:00 - #1999-01-13T09:00:00 - #1999-01-14T09:00:00 - #1999-01-15T09:00:00 - #1999-01-16T09:00:00 - #1999-01-17T09:00:00 - #1999-01-18T09:00:00 - #1999-01-19T09:00:00 - #1999-01-20T09:00:00 - #1999-01-21T09:00:00 - #1999-01-22T09:00:00 - #1999-01-23T09:00:00 - #1999-01-24T09:00:00 - #1999-01-25T09:00:00 - #1999-01-26T09:00:00 - #1999-01-27T09:00:00 - #1999-01-28T09:00:00 - #1999-01-29T09:00:00 - #1999-01-30T09:00:00 - #1999-01-31T09:00:00 - #2000-01-01T09:00:00 - #2000-01-02T09:00:00 - #2000-01-03T09:00:00 - #2000-01-04T09:00:00 - #2000-01-05T09:00:00 - #2000-01-06T09:00:00 - #2000-01-07T09:00:00 - #2000-01-08T09:00:00 - #2000-01-09T09:00:00 - #2000-01-10T09:00:00 - #2000-01-11T09:00:00 - #2000-01-12T09:00:00 - #2000-01-13T09:00:00 - #2000-01-14T09:00:00 - #2000-01-15T09:00:00 - #2000-01-16T09:00:00 - #2000-01-17T09:00:00 - #2000-01-18T09:00:00 - #2000-01-19T09:00:00 - #2000-01-20T09:00:00 - #2000-01-21T09:00:00 - #2000-01-22T09:00:00 - #2000-01-23T09:00:00 - #2000-01-24T09:00:00 - #2000-01-25T09:00:00 - #2000-01-26T09:00:00 - #2000-01-27T09:00:00 - #2000-01-28T09:00:00 - #2000-01-29T09:00:00 - #2000-01-30T09:00:00 - #2000-01-31T09:00:00)) - - (vevent - summary: "Every day in January, for 3 years (alt 2)" - dtstart: "19980101T090000" - rrule: "FREQ=DAILY;UNTIL=20000131T140000Z;BYMONTH=1" - x-summary: "dagligen, till och med den 31 januari, 2000 kl. 14:00" - x-set: (list #1998-01-01T09:00:00 - #1998-01-02T09:00:00 - #1998-01-03T09:00:00 - #1998-01-04T09:00:00 - #1998-01-05T09:00:00 - #1998-01-06T09:00:00 - #1998-01-07T09:00:00 - #1998-01-08T09:00:00 - #1998-01-09T09:00:00 - #1998-01-10T09:00:00 - #1998-01-11T09:00:00 - #1998-01-12T09:00:00 - #1998-01-13T09:00:00 - #1998-01-14T09:00:00 - #1998-01-15T09:00:00 - #1998-01-16T09:00:00 - #1998-01-17T09:00:00 - #1998-01-18T09:00:00 - #1998-01-19T09:00:00 - #1998-01-20T09:00:00 - #1998-01-21T09:00:00 - #1998-01-22T09:00:00 - #1998-01-23T09:00:00 - #1998-01-24T09:00:00 - #1998-01-25T09:00:00 - #1998-01-26T09:00:00 - #1998-01-27T09:00:00 - #1998-01-28T09:00:00 - #1998-01-29T09:00:00 - #1998-01-30T09:00:00 - #1998-01-31T09:00:00 - #1999-01-01T09:00:00 - #1999-01-02T09:00:00 - #1999-01-03T09:00:00 - #1999-01-04T09:00:00 - #1999-01-05T09:00:00 - #1999-01-06T09:00:00 - #1999-01-07T09:00:00 - #1999-01-08T09:00:00 - #1999-01-09T09:00:00 - #1999-01-10T09:00:00 - #1999-01-11T09:00:00 - #1999-01-12T09:00:00 - #1999-01-13T09:00:00 - #1999-01-14T09:00:00 - #1999-01-15T09:00:00 - #1999-01-16T09:00:00 - #1999-01-17T09:00:00 - #1999-01-18T09:00:00 - #1999-01-19T09:00:00 - #1999-01-20T09:00:00 - #1999-01-21T09:00:00 - #1999-01-22T09:00:00 - #1999-01-23T09:00:00 - #1999-01-24T09:00:00 - #1999-01-25T09:00:00 - #1999-01-26T09:00:00 - #1999-01-27T09:00:00 - #1999-01-28T09:00:00 - #1999-01-29T09:00:00 - #1999-01-30T09:00:00 - #1999-01-31T09:00:00 - #2000-01-01T09:00:00 - #2000-01-02T09:00:00 - #2000-01-03T09:00:00 - #2000-01-04T09:00:00 - #2000-01-05T09:00:00 - #2000-01-06T09:00:00 - #2000-01-07T09:00:00 - #2000-01-08T09:00:00 - #2000-01-09T09:00:00 - #2000-01-10T09:00:00 - #2000-01-11T09:00:00 - #2000-01-12T09:00:00 - #2000-01-13T09:00:00 - #2000-01-14T09:00:00 - #2000-01-15T09:00:00 - #2000-01-16T09:00:00 - #2000-01-17T09:00:00 - #2000-01-18T09:00:00 - #2000-01-19T09:00:00 - #2000-01-20T09:00:00 - #2000-01-21T09:00:00 - #2000-01-22T09:00:00 - #2000-01-23T09:00:00 - #2000-01-24T09:00:00 - #2000-01-25T09:00:00 - #2000-01-26T09:00:00 - #2000-01-27T09:00:00 - #2000-01-28T09:00:00 - #2000-01-29T09:00:00 - #2000-01-30T09:00:00 - #2000-01-31T09:00:00)) - - (vevent - summary: "Weekly for 10 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=WEEKLY;COUNT=10" - x-summary: "varje vecka, totalt 10 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-09T09:00:00 - #1997-09-16T09:00:00 - #1997-09-23T09:00:00 - #1997-09-30T09:00:00 - #1997-10-07T09:00:00 - #1997-10-14T09:00:00 - #1997-10-21T09:00:00 - #1997-10-28T09:00:00 - #1997-11-04T09:00:00)) - - (vevent - summary: "Weekly until December 24, 1997" - dtstart: "19970902T090000" - rrule: "FREQ=WEEKLY;UNTIL=19971224T000000Z" - x-summary: "varje vecka, till och med den 24 december, 1997 kl. 0:00" - x-set: (list #1997-09-02T09:00:00 - #1997-09-09T09:00:00 - #1997-09-16T09:00:00 - #1997-09-23T09:00:00 - #1997-09-30T09:00:00 - #1997-10-07T09:00:00 - #1997-10-14T09:00:00 - #1997-10-21T09:00:00 - #1997-10-28T09:00:00 - #1997-11-04T09:00:00 - #1997-11-11T09:00:00 - #1997-11-18T09:00:00 - #1997-11-25T09:00:00 - #1997-12-02T09:00:00 - #1997-12-09T09:00:00 - #1997-12-16T09:00:00 - #1997-12-23T09:00:00)) - - (vevent - summary: "Every other week - forever" - dtstart: "19970902T090000" - rrule: "FREQ=WEEKLY;INTERVAL=2;WKST=SU" - x-summary: "varannan vecka" - x-set: (list #1997-09-02T09:00:00 - #1997-09-16T09:00:00 - #1997-09-30T09:00:00 - #1997-10-14T09:00:00 - #1997-10-28T09:00:00 - #1997-11-11T09:00:00 - #1997-11-25T09:00:00 - #1997-12-09T09:00:00 - #1997-12-23T09:00:00 - #1998-01-06T09:00:00 - #1998-01-20T09:00:00 - #1998-02-03T09:00:00 - #1998-02-17T09:00:00 - #1998-03-03T09:00:00 - #1998-03-17T09:00:00 - #1998-03-31T09:00:00 - #1998-04-14T09:00:00 - #1998-04-28T09:00:00 - #1998-05-12T09:00:00 - #1998-05-26T09:00:00)) - - (vevent - summary: "Weekly on Tuesday and Thursday for five weeks (alt 1)" - dtstart: "19970902T090000" - rrule: "FREQ=WEEKLY;UNTIL=19971007T000000Z;WKST=SU;BYDAY=TU,TH" - x-summary: "varje tisdag & torsdag, till och med den 07 oktober, 1997 kl. 0:00" - x-set: (list #1997-09-02T09:00:00 - #1997-09-04T09:00:00 - #1997-09-09T09:00:00 - #1997-09-11T09:00:00 - #1997-09-16T09:00:00 - #1997-09-18T09:00:00 - #1997-09-23T09:00:00 - #1997-09-25T09:00:00 - #1997-09-30T09:00:00 - #1997-10-02T09:00:00)) - - (vevent - summary: "Weekly on Tuesday and Thursday for five weeks (alt 2)" - dtstart: "19970902T090000" - rrule: "FREQ=WEEKLY;COUNT=10;WKST=SU;BYDAY=TU,TH" - x-summary: "varje tisdag & torsdag, totalt 10 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-04T09:00:00 - #1997-09-09T09:00:00 - #1997-09-11T09:00:00 - #1997-09-16T09:00:00 - #1997-09-18T09:00:00 - #1997-09-23T09:00:00 - #1997-09-25T09:00:00 - #1997-09-30T09:00:00 - #1997-10-02T09:00:00)) - - (vevent - summary: "Every other week on Monday, Wednesday, and Friday until December 24, 1997, starting on Monday, September 1, 1997:" - dtstart: "19970901T090000" - rrule: "FREQ=WEEKLY;INTERVAL=2;UNTIL=19971224T000000Z;WKST=SU;BYDAY=MO,WE,FR" - x-summary: "varannan måndag, onsdag & fredag, till och med den 24 december, 1997 kl. 0:00" - x-set: (list #1997-09-01T09:00:00 - #1997-09-03T09:00:00 - #1997-09-05T09:00:00 - #1997-09-15T09:00:00 - #1997-09-17T09:00:00 - #1997-09-19T09:00:00 - #1997-09-29T09:00:00 - #1997-10-01T09:00:00 - #1997-10-03T09:00:00 - #1997-10-13T09:00:00 - #1997-10-15T09:00:00 - #1997-10-17T09:00:00 - #1997-10-27T09:00:00 - #1997-10-29T09:00:00 - #1997-10-31T09:00:00 - #1997-11-10T09:00:00 - #1997-11-12T09:00:00 - #1997-11-14T09:00:00 - #1997-11-24T09:00:00 - #1997-11-26T09:00:00 - #1997-11-28T09:00:00 - #1997-12-08T09:00:00 - #1997-12-10T09:00:00 - #1997-12-12T09:00:00 - #1997-12-22T09:00:00)) - - (vevent - summary: "Every other week on Tuesday and Thursday, for 8 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=WEEKLY;INTERVAL=2;COUNT=8;WKST=SU;BYDAY=TU,TH" - x-summary: "varannan tisdag & torsdag, totalt 8 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-04T09:00:00 - #1997-09-16T09:00:00 - #1997-09-18T09:00:00 - #1997-09-30T09:00:00 - #1997-10-02T09:00:00 - #1997-10-14T09:00:00 - #1997-10-16T09:00:00)) - - (vevent - summary: "Monthly on the first Friday for 10 occurrences" - dtstart: "19970905T090000" - rrule: "FREQ=MONTHLY;COUNT=10;BYDAY=1FR" - x-summary: "första fredagen varje månad, totalt 10 gånger" - x-set: (list #1997-09-05T09:00:00 - #1997-10-03T09:00:00 - #1997-11-07T09:00:00 - #1997-12-05T09:00:00 - #1998-01-02T09:00:00 - #1998-02-06T09:00:00 - #1998-03-06T09:00:00 - #1998-04-03T09:00:00 - #1998-05-01T09:00:00 - #1998-06-05T09:00:00)) - - (vevent - summary: "Monthly on the first Friday until December 24, 1997" - dtstart: "19970905T090000" - rrule: "FREQ=MONTHLY;UNTIL=19971224T000000Z;BYDAY=1FR" - x-summary: "första fredagen varje månad, till och med den 24 december, 1997 kl. 0:00" - x-set: (list #1997-09-05T09:00:00 - #1997-10-03T09:00:00 - #1997-11-07T09:00:00 - #1997-12-05T09:00:00)) - - (vevent - summary: "Every other month on the first and last Sunday of the month for 10 occurrences" - dtstart: "19970907T090000" - rrule: "FREQ=MONTHLY;INTERVAL=2;COUNT=10;BYDAY=1SU,-1SU" - x-summary: "första söndagen samt sista söndagen varannan månad, totalt 10 gånger" - x-set: (list #1997-09-07T09:00:00 - #1997-09-28T09:00:00 - #1997-11-02T09:00:00 - #1997-11-30T09:00:00 - #1998-01-04T09:00:00 - #1998-01-25T09:00:00 - #1998-03-01T09:00:00 - #1998-03-29T09:00:00 - #1998-05-03T09:00:00 - #1998-05-31T09:00:00)) - - (vevent - summary: "Monthly on the second-to-last Monday of the month for 6 months" - dtstart: "19970922T090000" - rrule: "FREQ=MONTHLY;COUNT=6;BYDAY=-2MO" - x-summary: "näst sista måndagen varje månad, totalt 6 gånger" - x-set: (list #1997-09-22T09:00:00 - #1997-10-20T09:00:00 - #1997-11-17T09:00:00 - #1997-12-22T09:00:00 - #1998-01-19T09:00:00 - #1998-02-16T09:00:00)) - - (vevent - summary: "Monthly on the third-to-the-last day of the month, forever" - dtstart: "19970928T090000" - rrule: "FREQ=MONTHLY;BYMONTHDAY=-3" - x-summary: "den tredje sista varje månad" - x-set: (list #1997-09-28T09:00:00 - #1997-10-29T09:00:00 - #1997-11-28T09:00:00 - #1997-12-29T09:00:00 - #1998-01-29T09:00:00 - #1998-02-26T09:00:00 - #1998-03-29T09:00:00 - #1998-04-28T09:00:00 - #1998-05-29T09:00:00 - #1998-06-28T09:00:00 - #1998-07-29T09:00:00 - #1998-08-29T09:00:00 - #1998-09-28T09:00:00 - #1998-10-29T09:00:00 - #1998-11-28T09:00:00 - #1998-12-29T09:00:00 - #1999-01-29T09:00:00 - #1999-02-26T09:00:00 - #1999-03-29T09:00:00 - #1999-04-28T09:00:00)) - - (vevent - summary: "Monthly on the 2nd and 15th of the month for 10 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=MONTHLY;COUNT=10;BYMONTHDAY=2,15" - x-summary: "den andre & femtonde varje månad, totalt 10 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-15T09:00:00 - #1997-10-02T09:00:00 - #1997-10-15T09:00:00 - #1997-11-02T09:00:00 - #1997-11-15T09:00:00 - #1997-12-02T09:00:00 - #1997-12-15T09:00:00 - #1998-01-02T09:00:00 - #1998-01-15T09:00:00)) - - (vevent - summary: "Monthly on the first and last day of the month for 10 occurrences" - dtstart: "19970930T090000" - rrule: "FREQ=MONTHLY;COUNT=10;BYMONTHDAY=1,-1" - x-summary: "den förste & sista varje månad, totalt 10 gånger" - x-set: (list #1997-09-30T09:00:00 - #1997-10-01T09:00:00 - #1997-10-31T09:00:00 - #1997-11-01T09:00:00 - #1997-11-30T09:00:00 - #1997-12-01T09:00:00 - #1997-12-31T09:00:00 - #1998-01-01T09:00:00 - #1998-01-31T09:00:00 - #1998-03-01T09:00:00)) - - (vevent - summary: "Every 18 months on the 10th thru 15th of the month for 10 occurrences" - dtstart: "19970910T090000" - rrule: "FREQ=MONTHLY;INTERVAL=18;COUNT=10;BYMONTHDAY=10,11,12,13,14,15" - x-summary: "den tionde, elfte, tolfte, trettonde, fjortonde & femtonde var artonde månad, totalt 10 gånger" - x-set: (list #1997-09-10T09:00:00 - #1997-09-11T09:00:00 - #1997-09-12T09:00:00 - #1997-09-13T09:00:00 - #1997-09-14T09:00:00 - #1997-09-15T09:00:00 - #1999-03-10T09:00:00 - #1999-03-11T09:00:00 - #1999-03-12T09:00:00 - #1999-03-13T09:00:00)) - - (vevent - summary: "Every Tuesday, every other month" - dtstart: "19970902T090000" - rrule: "FREQ=MONTHLY;INTERVAL=2;BYDAY=TU" - x-summary: "varje tisdag varannan månad" - x-set: (list #1997-09-02T09:00:00 - #1997-09-09T09:00:00 - #1997-09-16T09:00:00 - #1997-09-23T09:00:00 - #1997-09-30T09:00:00 - #1997-11-04T09:00:00 - #1997-11-11T09:00:00 - #1997-11-18T09:00:00 - #1997-11-25T09:00:00 - #1998-01-06T09:00:00 - #1998-01-13T09:00:00 - #1998-01-20T09:00:00 - #1998-01-27T09:00:00 - #1998-03-03T09:00:00 - #1998-03-10T09:00:00 - #1998-03-17T09:00:00 - #1998-03-24T09:00:00 - #1998-03-31T09:00:00 - #1998-05-05T09:00:00 - #1998-05-12T09:00:00)) - - (vevent - summary: "Yearly in June and July for 10 occurrences: -: Since none of the BYDAY, BYMONTHDAY, or BYYEARDAY -onents are specified, the day is gotten from \"DTSTART\"" - dtstart: "19970610T090000" - rrule: "FREQ=YEARLY;COUNT=10;BYMONTH=6,7" - x-summary: "juni & juli, årligen, totalt 10 gånger" - x-set: (list #1997-06-10T09:00:00 - #1997-07-10T09:00:00 - #1998-06-10T09:00:00 - #1998-07-10T09:00:00 - #1999-06-10T09:00:00 - #1999-07-10T09:00:00 - #2000-06-10T09:00:00 - #2000-07-10T09:00:00 - #2001-06-10T09:00:00 - #2001-07-10T09:00:00)) - - (vevent - summary: "Every other year on January, February, and March for 10 occurrences" - dtstart: "19970310T090000" - rrule: "FREQ=YEARLY;INTERVAL=2;COUNT=10;BYMONTH=1,2,3" - x-summary: "januari, februari & mars vartannat år, totalt 10 gånger" - x-set: (list #1997-03-10T09:00:00 - #1999-01-10T09:00:00 - #1999-02-10T09:00:00 - #1999-03-10T09:00:00 - #2001-01-10T09:00:00 - #2001-02-10T09:00:00 - #2001-03-10T09:00:00 - #2003-01-10T09:00:00 - #2003-02-10T09:00:00 - #2003-03-10T09:00:00)) - - (vevent - summary: "Every third year on the 1st, 100th, and 200th day for 10 occurrences" - dtstart: "19970101T090000" - rrule: "FREQ=YEARLY;INTERVAL=3;COUNT=10;BYYEARDAY=1,100,200" - x-summary: "dag 1, 100 & 200 vart tredje år, totalt 10 gånger" - x-set: (list #1997-01-01T09:00:00 - #1997-04-10T09:00:00 - #1997-07-19T09:00:00 - #2000-01-01T09:00:00 - #2000-04-09T09:00:00 - #2000-07-18T09:00:00 - #2003-01-01T09:00:00 - #2003-04-10T09:00:00 - #2003-07-19T09:00:00 - #2006-01-01T09:00:00)) - - (vevent - summary: "Every 20th Monday of the year, forever" - dtstart: "19970519T090000" - rrule: "FREQ=YEARLY;BYDAY=20MO" - x-summary: "tjugonde måndagen, årligen" - x-set: (list #1997-05-19T09:00:00 - #1998-05-18T09:00:00 - #1999-05-17T09:00:00 - #2000-05-15T09:00:00 - #2001-05-14T09:00:00 - #2002-05-20T09:00:00 - #2003-05-19T09:00:00 - #2004-05-17T09:00:00 - #2005-05-16T09:00:00 - #2006-05-15T09:00:00 - #2007-05-14T09:00:00 - #2008-05-19T09:00:00 - #2009-05-18T09:00:00 - #2010-05-17T09:00:00 - #2011-05-16T09:00:00 - #2012-05-14T09:00:00 - #2013-05-20T09:00:00 - #2014-05-19T09:00:00 - #2015-05-18T09:00:00 - #2016-05-16T09:00:00)) - - (vevent - summary: "Monday of week number 20 (where the default start of the week is Monday), forever" - dtstart: "19970512T090000" - rrule: "FREQ=YEARLY;BYWEEKNO=20;BYDAY=MO" - x-summary: "varje måndag v.20, årligen" - x-set: (list #1997-05-12T09:00:00 - #1998-05-11T09:00:00 - #1999-05-17T09:00:00 - #2000-05-15T09:00:00 - #2001-05-14T09:00:00 - #2002-05-13T09:00:00 - #2003-05-12T09:00:00 - #2004-05-10T09:00:00 - #2005-05-16T09:00:00 - #2006-05-15T09:00:00 - #2007-05-14T09:00:00 - #2008-05-12T09:00:00 - #2009-05-11T09:00:00 - #2010-05-17T09:00:00 - #2011-05-16T09:00:00 - #2012-05-14T09:00:00 - #2013-05-13T09:00:00 - #2014-05-12T09:00:00 - #2015-05-11T09:00:00 - #2016-05-16T09:00:00)) - - (vevent - summary: "Every Thursday in March, forever" - dtstart: "19970313T090000" - rrule: "FREQ=YEARLY;BYMONTH=3;BYDAY=TH" - x-summary: "varje torsdag i mars, årligen" - x-set: (list #1997-03-13T09:00:00 - #1997-03-20T09:00:00 - #1997-03-27T09:00:00 - #1998-03-05T09:00:00 - #1998-03-12T09:00:00 - #1998-03-19T09:00:00 - #1998-03-26T09:00:00 - #1999-03-04T09:00:00 - #1999-03-11T09:00:00 - #1999-03-18T09:00:00 - #1999-03-25T09:00:00 - #2000-03-02T09:00:00 - #2000-03-09T09:00:00 - #2000-03-16T09:00:00 - #2000-03-23T09:00:00 - #2000-03-30T09:00:00 - #2001-03-01T09:00:00 - #2001-03-08T09:00:00 - #2001-03-15T09:00:00 - #2001-03-22T09:00:00)) - - (vevent - summary: "Every Thursday, but only during June, July, and August, forever" - dtstart: "19970605T090000" - rrule: "FREQ=YEARLY;BYDAY=TH;BYMONTH=6,7,8" - x-summary: "varje torsdag i juni, juli & augusti, årligen" - x-set: (list #1997-06-05T09:00:00 - #1997-06-12T09:00:00 - #1997-06-19T09:00:00 - #1997-06-26T09:00:00 - #1997-07-03T09:00:00 - #1997-07-10T09:00:00 - #1997-07-17T09:00:00 - #1997-07-24T09:00:00 - #1997-07-31T09:00:00 - #1997-08-07T09:00:00 - #1997-08-14T09:00:00 - #1997-08-21T09:00:00 - #1997-08-28T09:00:00 - #1998-06-04T09:00:00 - #1998-06-11T09:00:00 - #1998-06-18T09:00:00 - #1998-06-25T09:00:00 - #1998-07-02T09:00:00 - #1998-07-09T09:00:00 - #1998-07-16T09:00:00)) - - (vevent - summary: "Every Friday the 13th, forever" - dtstart: "19970902T090000" - exdate: "19970902T090000" - rrule: "FREQ=MONTHLY;BYDAY=FR;BYMONTHDAY=13" - x-summary: "varje fredag den trettonde varje månad" - x-set: (list #1998-02-13T09:00:00 - #1998-03-13T09:00:00 - #1998-11-13T09:00:00 - #1999-08-13T09:00:00 - #2000-10-13T09:00:00 - #2001-04-13T09:00:00 - #2001-07-13T09:00:00 - #2002-09-13T09:00:00 - #2002-12-13T09:00:00 - #2003-06-13T09:00:00 - #2004-02-13T09:00:00 - #2004-08-13T09:00:00 - #2005-05-13T09:00:00 - #2006-01-13T09:00:00 - #2006-10-13T09:00:00 - #2007-04-13T09:00:00 - #2007-07-13T09:00:00 - #2008-06-13T09:00:00 - #2009-02-13T09:00:00 - #2009-03-13T09:00:00)) - - (vevent - summary: "The first Saturday that follows the first Sunday of the month, forever" - dtstart: "19970913T090000" - rrule: "FREQ=MONTHLY;BYDAY=SA;BYMONTHDAY=7,8,9,10,11,12,13" - x-summary: "varje lördag den sjunde, åttonde, nionde, tionde, elfte, tolfte & trettonde varje månad" - x-set: (list #1997-09-13T09:00:00 - #1997-10-11T09:00:00 - #1997-11-08T09:00:00 - #1997-12-13T09:00:00 - #1998-01-10T09:00:00 - #1998-02-07T09:00:00 - #1998-03-07T09:00:00 - #1998-04-11T09:00:00 - #1998-05-09T09:00:00 - #1998-06-13T09:00:00 - #1998-07-11T09:00:00 - #1998-08-08T09:00:00 - #1998-09-12T09:00:00 - #1998-10-10T09:00:00 - #1998-11-07T09:00:00 - #1998-12-12T09:00:00 - #1999-01-09T09:00:00 - #1999-02-13T09:00:00 - #1999-03-13T09:00:00 - #1999-04-10T09:00:00)) - - (vevent - summary: - "Every 4 years, the first Tuesday after a Monday in November, -ver (U.S. Presidential Election day)" - dtstart: "19961105T090000" - rrule: "FREQ=YEARLY;INTERVAL=4;BYMONTH=11;BYDAY=TU;BYMONTHDAY=2,3,4,5,6,7,8" - x-summary: "varje tisdag den andre, tredje, fjärde, femte, sjätte, sjunde eller åttonde i november vart fjärde år" - x-set: (list #1996-11-05T09:00:00 - #2000-11-07T09:00:00 - #2004-11-02T09:00:00 - #2008-11-04T09:00:00 - #2012-11-06T09:00:00 - #2016-11-08T09:00:00 - #2020-11-03T09:00:00 - #2024-11-05T09:00:00 - #2028-11-07T09:00:00 - #2032-11-02T09:00:00 - #2036-11-04T09:00:00 - #2040-11-06T09:00:00 - #2044-11-08T09:00:00 - #2048-11-03T09:00:00 - #2052-11-05T09:00:00 - #2056-11-07T09:00:00 - #2060-11-02T09:00:00 - #2064-11-04T09:00:00 - #2068-11-06T09:00:00 - #2072-11-08T09:00:00)) - - (vevent - summary: "The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months" - dtstart: "19970904T090000" - rrule: "FREQ=MONTHLY;COUNT=3;BYDAY=TU,WE,TH;BYSETPOS=3" - x-summary: "NOT YET IMPLEMENTED" - x-set: (list #1997-09-04T09:00:00 - #1997-10-07T09:00:00 - #1997-11-06T09:00:00)) - - (vevent - summary: "The second-to-last weekday of the month" - dtstart: "19970929T090000" - rrule: "FREQ=MONTHLY;BYDAY=MO,TU,WE,TH,FR;BYSETPOS=-2" - x-summary: "NOT YET IMPLEMENTED" - x-set: (list #1997-09-29T09:00:00 - #1997-10-30T09:00:00 - #1997-11-27T09:00:00 - #1997-12-30T09:00:00 - #1998-01-29T09:00:00)) - - (vevent - summary: "Every 3 hours from 9:00 AM to 5:00 PM on a specific day" - dtstart: "19970902T090000" - rrule: "FREQ=HOURLY;INTERVAL=3;UNTIL=19970902T170000Z" - x-summary: "var tredje timme, till och med den 02 september, 1997 kl. 17:00" - x-set: (list #1997-09-02T09:00:00 - #1997-09-02T12:00:00 - #1997-09-02T15:00:00)) - - (vevent - summary: "Every 15 minutes for 6 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=MINUTELY;INTERVAL=15;COUNT=6" - x-summary: "varje kvart, totalt 6 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-02T09:15:00 - #1997-09-02T09:30:00 - #1997-09-02T09:45:00 - #1997-09-02T10:00:00 - #1997-09-02T10:15:00)) - - (vevent - summary: "Every hour and a half for 4 occurrences" - dtstart: "19970902T090000" - rrule: "FREQ=MINUTELY;INTERVAL=90;COUNT=4" - x-summary: "var sjätte kvart, totalt 4 gånger" - x-set: (list #1997-09-02T09:00:00 - #1997-09-02T10:30:00 - #1997-09-02T12:00:00 - #1997-09-02T13:30:00)) - - (vevent - summary: "Every 20 minutes from 9:00 AM to 4:40 PM every day (alt 1)" - dtstart: "19970902T090000" - rrule: "FREQ=DAILY;BYHOUR=9,10,11,12,13,14,15,16;BYMINUTE=0,20,40" - x-summary: "dagligen kl. 09:00, 09:20, 09:40, 10:00, 10:20, 10:40, 11:00, 11:20, 11:40, 12:00, 12:20, 12:40, 13:00, 13:20, 13:40, 14:00, 14:20, 14:40, 15:00, 15:20, 15:40, 16:00, 16:20 & 16:40" - x-set: (list #1997-09-02T09:00:00 - #1997-09-02T09:20:00 - #1997-09-02T09:40:00 - #1997-09-02T10:00:00 - #1997-09-02T10:20:00 - #1997-09-02T10:40:00 - #1997-09-02T11:00:00 - #1997-09-02T11:20:00 - #1997-09-02T11:40:00 - #1997-09-02T12:00:00 - #1997-09-02T12:20:00 - #1997-09-02T12:40:00 - #1997-09-02T13:00:00 - #1997-09-02T13:20:00 - #1997-09-02T13:40:00 - #1997-09-02T14:00:00 - #1997-09-02T14:20:00 - #1997-09-02T14:40:00 - #1997-09-02T15:00:00 - #1997-09-02T15:20:00)) - - (vevent - summary: "Every 20 minutes from 9:00 AM to 4:40 PM every day (alt 2)" - dtstart: "19970902T090000" - rrule: "FREQ=MINUTELY;INTERVAL=20;BYHOUR=9,10,11,12,13,14,15,16" - x-summary: "var tjugonde minut kl. 9, 10, 11, 12, 13, 14, 15 & 16" - x-set: (list #1997-09-02T09:00:00 - #1997-09-02T09:20:00 - #1997-09-02T09:40:00 - #1997-09-02T10:00:00 - #1997-09-02T10:20:00 - #1997-09-02T10:40:00 - #1997-09-02T11:00:00 - #1997-09-02T11:20:00 - #1997-09-02T11:40:00 - #1997-09-02T12:00:00 - #1997-09-02T12:20:00 - #1997-09-02T12:40:00 - #1997-09-02T13:00:00 - #1997-09-02T13:20:00 - #1997-09-02T13:40:00 - #1997-09-02T14:00:00 - #1997-09-02T14:20:00 - #1997-09-02T14:40:00 - #1997-09-02T15:00:00 - #1997-09-02T15:20:00)) - - (vevent - summary: "An example where the days generated makes a difference because of WKST" - dtstart: "19970805T090000" - rrule: "FREQ=WEEKLY;INTERVAL=2;COUNT=4;BYDAY=TU,SU;WKST=MO" - x-summary: "varannan tisdag & söndag, totalt 4 gånger" - x-set: (list #1997-08-05T09:00:00 - #1997-08-10T09:00:00 - #1997-08-19T09:00:00 - #1997-08-24T09:00:00)) - - (vevent - summary: "changing only WKST from MO to SU, yields different results.." - dtstart: "19970805T090000" - rrule: "FREQ=WEEKLY;INTERVAL=2;COUNT=4;BYDAY=TU,SU;WKST=SU" - x-summary: "varannan tisdag & söndag, totalt 4 gånger" - x-set: (list #1997-08-05T09:00:00 - #1997-08-17T09:00:00 - #1997-08-19T09:00:00 - #1997-08-31T09:00:00)) - - (vevent - summary: "An example where an invalid date (i.e., February 30) is ignored" - dtstart: "20070115T090000" - rrule: "FREQ=MONTHLY;BYMONTHDAY=15,30;COUNT=5" - x-summary: "den femtonde & tretionde varje månad, totalt 5 gånger" - x-set: (list #2007-01-15T09:00:00 - #2007-01-30T09:00:00 - #2007-02-15T09:00:00 - #2007-03-15T09:00:00 - #2007-03-30T09:00:00)) - - - - ;; End of examples from RFC, start of own examples - - (vevent - summary: "Every Friday & Wednesday the 13th, forever" - dtstart: "19970902T090000" - exdate: "19970902T090000" - rrule: "FREQ=MONTHLY;BYDAY=FR,WE;BYMONTHDAY=13" - x-summary: "varje onsdag & fredag den trettonde varje månad" - x-set: (list #1998-02-13T09:00:00 - #1998-03-13T09:00:00 - #1998-05-13T09:00:00 - #1998-11-13T09:00:00 - #1999-01-13T09:00:00 - #1999-08-13T09:00:00 - #1999-10-13T09:00:00 - #2000-09-13T09:00:00 - #2000-10-13T09:00:00 - #2000-12-13T09:00:00 - #2001-04-13T09:00:00 - #2001-06-13T09:00:00 - #2001-07-13T09:00:00 - #2002-02-13T09:00:00 - #2002-03-13T09:00:00 - #2002-09-13T09:00:00 - #2002-11-13T09:00:00 - #2002-12-13T09:00:00 - #2003-06-13T09:00:00 - #2003-08-13T09:00:00)) - - (vevent - summary: "Monday & Wednesday of week number 20 (where the default start of the week is Monday), forever" - dtstart: "19970512T090000" - rrule: "FREQ=YEARLY;BYWEEKNO=20;BYDAY=MO,WE" - x-summary: "varje onsdag & måndag v.20, årligen" - x-set: (list #1997-05-12T09:00:00 - #1997-05-14T09:00:00 - #1998-05-11T09:00:00 - #1998-05-13T09:00:00 - #1999-05-17T09:00:00 - #1999-05-19T09:00:00 - #2000-05-15T09:00:00 - #2000-05-17T09:00:00 - #2001-05-14T09:00:00 - #2001-05-16T09:00:00 - #2002-05-13T09:00:00 - #2002-05-15T09:00:00 - #2003-05-12T09:00:00 - #2003-05-14T09:00:00 - #2004-05-10T09:00:00 - #2004-05-12T09:00:00 - #2005-05-16T09:00:00 - #2005-05-18T09:00:00 - #2006-05-15T09:00:00 - #2006-05-17T09:00:00)))) diff --git a/tests/recurrence-simple.scm b/tests/recurrence-simple.scm deleted file mode 100644 index d5a35802..00000000 --- a/tests/recurrence-simple.scm +++ /dev/null @@ -1,287 +0,0 @@ -;;; Commentary: -;; Simples tests of recurrence system, ensuring that all parsers and -;; basic generators work. Some more fully-featured tests are here, but -;; most are instead in recurrence-advanced.scm. -;;; Code: - -(((srfi srfi-41) stream-take stream-map stream->list stream-car) - ((datetime) day-stream mon) - ((vcomponent base) extract prop) - - ((hnh util exceptions) warnings-are-errors warning-handler) - ((guile) format @@) - - ((vcomponent formats ical parse) parse-calendar) - ((vcomponent formats xcal parse) sxcal->vcomponent) - ((vcomponent recurrence) - parse-recurrence-rule - make-recur-rule - generate-recurrence-set)) - -;;; Test that basic parsing or recurrence rules work. - -(test-equal (make-recur-rule freq: 'HOURLY wkst: mon interval: 1) - (parse-recurrence-rule "FREQ=HOURLY")) - -(test-equal (make-recur-rule freq: 'HOURLY count: 3 interval: 1 wkst: mon) - (parse-recurrence-rule "FREQ=HOURLY;COUNT=3")) - -;;; Test that recurrence rule parsing fails where appropriate - -(parameterize ((warnings-are-errors #t) - (warning-handler identity)) ; silence warnings - (test-error "Invalid FREQ" 'warning - (parse-recurrence-rule "FREQ=ERR;COUNT=3")) - - (test-error "Negative COUNT" 'warning - (parse-recurrence-rule "FREQ=HOURLY;COUNT=-1")) - - (test-error "Invalid COUNT" - 'wrong-type-argument - (parse-recurrence-rule "FREQ=HOURLY;COUNT=err")) ) - -;;; Test that basic recurrence works -;;; also see the neighbour test file recurrence.scm for more tests. - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART;VALUE=DATE:20190302 -RRULE:FREQ=DAILY -END:VEVENT" - parse-calendar)) - -(test-assert "Generate at all" - (stream-car (generate-recurrence-set ev))) - -(test-assert "Generate some" - (stream->list (stream-take 5 (generate-recurrence-set ev)))) - -(test-equal "Generate First" - (stream->list - 5 (stream-map (extract 'DTSTART) - (generate-recurrence-set ev))) - (stream->list - 5 (day-stream - (prop ev 'DTSTART)))) - -;; We run the exact same thing a secound time, since I had an error with -;; that during development. - -(test-equal "Generate Again" - (stream->list - (stream-take - 5 (stream-map (extract 'DTSTART) - (generate-recurrence-set ev)))) - (stream->list - (stream-take - 5 (day-stream - (prop ev 'DTSTART))))) - - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART:20190302T100000 -RRULE:FREQ=DAILY -END:VEVENT" - parse-calendar) ) - -(test-assert "daily 10:00" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART:20190302T100000 -DTEND:20190302T120000 -RRULE:FREQ=DAILY -END:VEVENT" - parse-calendar)) - -(test-assert "daily 10-12" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART:20190302T100000 -DTEND:20190302T120000 -RRULE:FREQ=WEEKLY -END:VEVENT" - parse-calendar)) - -(test-assert "weekly 10-12" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART;TZID=Europe/Stockholm:20190302T100000 -DTEND;TZID=Europe/Stockholm:20190302T120000 -RRULE:FREQ=WEEKLY -END:VEVENT" - parse-calendar)) - -(test-assert "weekly TZ 10-12" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART;TZID=Europe/Stockholm:20190302T100000 -DTEND;TZID=Europe/Stockholm:20190302T120000 -RRULE:FREQ=WEEKLY -SEQUENCE:1 -END:VEVENT" - parse-calendar)) - -(test-assert "weekly TZ SEQUENCE 10-12" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART;TZID=Europe/Stockholm:20190302T100000 -RRULE:FREQ=WEEKLY -DTEND;TZID=Europe/Stockholm:20190302T120000 -SEQUENCE:1 -LOCATION:Here -END:VEVENT" - parse-calendar)) - -(test-assert "weekly TZ SEQUENCE LOCATION 10-12" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART:20180117T170000 -RRULE:FREQ=WEEKLY -LOCATION:~ -END:VEVENT" - parse-calendar)) - -(test-assert "Just location" - (stream-car (generate-recurrence-set ev))) - - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART;TZID=Europe/Stockholm:20180117T170000 -DTEND;TZID=Europe/Stockholm:20180117T200000 -RRULE:FREQ=WEEKLY -END:VEVENT" - parse-calendar)) - -(test-assert "Same times" - (stream-car (generate-recurrence-set ev))) - -(define ev - (call-with-input-string - "BEGIN:VEVENT -DTSTART;TZID=Europe/Stockholm:20180117T170000 -RRULE:FREQ=WEEKLY -DTEND;TZID=Europe/Stockholm:20180117T200000 -SEQUENCE:1 -LOCATION:~ -END:VEVENT" - parse-calendar)) - -;; errer in dtend ? - -(test-assert "Full test" - (stream-car (generate-recurrence-set ev))) - -;;; Tests that exceptions (in the recurrence-id meaning) -;;; in recurrence sets are handled correctly. -;;; TODO Is however far from done. - -(define uid (symbol->string (gensym "areallyuniqueid"))) - -;; TODO standardize vcomponents for tests as xcal, for example: -`(vcalendar - (children - (vevent - (properties - (summary (text "Changing type on Recurrence-id.")) - (uid (text ,uid)) - (dtstart (date "20090127")))) - (vevent - (properties - (summary (text "Changing type on Recurrence-id.")) - (uid (text ,uid)) - (dtstart (params (TZID "Europe/Stockholm")) - (date-time "20100127T120000")) - (recurrence-id (date "20100127")) - (summary "This instance only has a time component"))))) - -(define ev - (call-with-input-string - (format #f "BEGIN:VCALENDAR -BEGIN:VEVENT -SUMMARY:Changing type on Recurrence-id. -UID:~a -DTSTART;VALUE=DATE:20090127 -END:VEVENT -BEGIN:VEVENT -UID:~a -SUMMARY:Changing type on Recurrence-id. -DTSTART;TZID=Europe/Stockholm:20100127T120000 -RECURRENCE-ID;VALUE=DATE:20100127 -SUMMARY:This instance only has a time component -END:VEVENT -END:VCALENDAR" - uid uid) - parse-calendar)) - - -(test-assert "Changing type on Recurrence id." - (stream->list 10 (generate-recurrence-set ev))) - -;;; Earlier I failed to actually parse the recurrence parts, in short, 1 ≠ "1". - -(test-assert "Test that xcal recur rules are parseable" - ((@@ (vcomponent formats xcal parse) handle-value) - 'recur 'props-are-unused-for-recur - '((freq "WEEKLY") - (interval "1") - (wkst "MO")))) - -(define ev - (sxcal->vcomponent - '(vevent - (properties - (summary (text "reptest")) - (dtend (date-time "2021-01-13T02:00:00")) - (dtstart (date-time "2021-01-13T01:00:00")) - (uid (text "RNW198S6QANQPV1C4FDNFH6ER1VZX6KXEYNB")) - (rrule (recur (freq "WEEKLY") - (interval "1") - (wkst "MO"))) - (dtstamp (date-time "2021-01-13T01:42:20Z")) - (sequence (integer "0"))) - (components)))) - -(test-assert - "Check that recurrence rule commint from xcal also works" - (generate-recurrence-set ev)) - -;;; TODO test here, for byday parsing, and multiple byday instances in one recur element -;;; TODO which should also test serializing and deserializing to xcal. -;;; For example, the following rules specify every workday - -;; BEGIN:VCALENDAR -;; PRODID:-//hugo//calp 0.6.1//EN -;; VERSION:2.0 -;; CALSCALE:GREGORIAN -;; BEGIN:VEVENT -;; SUMMARY:Lunch -;; DTSTART:20211129T133000 -;; DTEND:20211129T150000 -;; LAST-MODIFIED:20211204T220944Z -;; UID:3d82c73c-6cdb-4799-beba-5f1d20d55347 -;; RRULE:FREQ=DAILY;BYDAY=MO,TU,WE,TH,FR -;; END:VEVENT -;; END:VCALENDAR diff --git a/tests/rrule-serialization.scm b/tests/rrule-serialization.scm deleted file mode 100644 index 53365661..00000000 --- a/tests/rrule-serialization.scm +++ /dev/null @@ -1,76 +0,0 @@ -( - ;; Yes, this is ugly. But how else would I test a private procedure? - ((guile) @@) - - ((vcomponent recurrence internal) - recur-rule->rrule-string - recur-rule->rrule-sxml - byday - ) - - ((vcomponent recurrence parse) parse-recurrence-rule) - - ((ice-9 peg) - keyword-flatten - ) - ) - - -(test-equal - "Parse of week day" - '(#f . 3) - ((@@ (vcomponent recurrence parse) parse-day-spec) "WE")) - -(test-equal - "Parse of week day with positive offset" - '(1 . 3) - ((@@ (vcomponent recurrence parse) parse-day-spec) "1WE")) - -(test-equal - "Parse of week day with positive offset (and plus)" - '(2 . 3) - ((@@ (vcomponent recurrence parse) parse-day-spec) "+2WE")) - -(test-equal - "Parse of week day with negative offset" - '(-3 . 3) - ((@@ (vcomponent recurrence parse) parse-day-spec) "-3WE")) - - -;; numeric prefixes in the BYDAY list is only valid when -;; FREQ={MONTHLY,YEARLY}, but that should be handled in a -;; later stage since we are just testing the parser here. -;; (p. 41) - - -(define field->string - (@@ (vcomponent recurrence internal) field->string)) - - -(let ((rule (parse-recurrence-rule "BYDAY=MO,TU,WE"))) - (test-equal "Direct return of parsed value" - "MO,TU,WE" - (field->string 'byday (byday rule))) - - (test-equal "Direct return, but as SXML" - '((byday "MO") - (byday "TU") - (byday "WE")) - (filter (lambda (pair) - (eq? 'byday (car pair))) - (keyword-flatten '(interval byday wkst) - (recur-rule->rrule-sxml rule))))) - -(let ((rule (parse-recurrence-rule "BYDAY=+1MO,1TU,-2FR"))) - (test-equal "Direct return of parsed value" - "1MO,1TU,-2FR" - (field->string 'byday (byday rule))) - - (test-equal "Direct return, but as SXML" - '((byday "1MO") - (byday "1TU") - (byday "-2FR")) - (filter (lambda (pair) - (eq? 'byday (car pair))) - (keyword-flatten '(interval byday wkst) - (recur-rule->rrule-sxml rule))))) diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 941b1b54..74d54a19 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -5,45 +5,29 @@ here=$(dirname $(realpath $0)) . "$(dirname "$here")/env" -make -C $(dirname $here) GUILE="$GUILE" go_files - -exec $GUILE --debug -s "$0" "$@" +if [ "$DEBUG" = '' ]; then + exec $GUILE -s "$0" "$@" +else + exec $GUILE --debug -s "$0" "$@" +fi !# -;;; Commentary: -;; Not a test, but a script that runs tests. -;; Assumes that all other .scm files in this directory are test files, -;; and should thereby follow the test-file syntax. -;; Note that the --debug flag in the (extended) shebang is REQUIRED, -;; otherwise the coverage tests do nothing. -;; -;; Each test runs in its own sandbox. This is however only to protect -;; the modules from each other, and to prevent polution of the global -;; namespace. The system IS NOT protected from the modules. -;; -;; Each test file is required to start with an s-expression on the -;; form: -;; @lisp -;; ((library binding ...) ...) -;; @end lisp -;; Which details exactly which modules should be imported. The format -;; is the same as make-sandbox-module. For example: -;; @example -;; (((c lex) lex) -;; ((c parse) parse-lexeme-tree)) -;; @end example -;; pulls in the @code{lex} procedure from @code{(c lex)}, and -;; @code{parse-lexeme-tree} from @code{(c parse)}. -;; Remaining forms in the file can be any valid scheme expression. -;; @code{define}s are allowed, but only where they would be allowed -;; inside a let form in general code (so only at the start for Guile -;; 2.2, anywhere for Guile 3.0). -;;; Code: - -(eval-when (compile load eval) - (define here (dirname (current-filename)))) - -(use-modules (srfi srfi-64)) +(format #t "current-filename = ~s~%" (current-filename)) + +(define here (dirname (current-filename))) + +(use-modules (srfi srfi-1) + (srfi srfi-64) + (srfi srfi-88) + (hnh util path) + (ice-9 ftw) + (ice-9 format) + (ice-9 getopt-long) + (system vm coverage) + ) + + + (define (µs x) (* x #e1e6)) @@ -114,139 +98,85 @@ exec $GUILE --debug -s "$0" "$@" (test-runner-factory construct-test-runner) -(use-modules (ice-9 ftw) - (ice-9 sandbox) - (ice-9 getopt-long) - (srfi srfi-88) ; suffix keywords - (system vm coverage) - ((hnh util) :select (for awhen)) - ;; datetime introduces the reader extensions for datetimes, - ;; which leaks into the sandboxes below. - (datetime) - ((srfi srfi-1) :select (take-while drop))) + + +(define (rework-coverage data) + (define-values (module-files module-names) + ((@ (all-modules) all-modules-under-directory) + (path-append (dirname here) "module"))) -(define files - (scandir here - (lambda (name) - (and (< 2 (string-length name)) - (not (string=? name (basename (current-filename)))) - (string=? "scm" (string-take-right name 3)))))) + (define to-drop + (1+ (length + (take-while (lambda (p) (not (string=? p "module"))) + (path-split (car module-files)))))) + (define (drop-components path-list) + (drop path-list to-drop)) + (define target-ht (make-hash-table)) + (define source-ht ((@@ (system vm coverage) data-file->line-counts) data)) + (for-each (lambda (path) + (cond ((hash-ref source-ht path #f) + => (lambda (value) (hash-set! target-ht path value))))) + (map (compose path-join drop-components path-split) module-files)) -;; Load tests + ((@@ (system vm coverage) %make-coverage-data) + ((@@ (system vm coverage) data-ip-counts) data) + ((@@ (system vm coverage) data-sources) data) + ((@@ (system vm coverage) data-file->procedures) data) + target-ht)) -(define (read-multiple) - (let loop ((done '())) - (let ((sexp (read))) - (if (eof-object? sexp) - (reverse done) - (loop (cons sexp done)))))) -(define options + + +(define option-spec '((skip (value #t)) (only (value #t)) - (verbose (single-char #\v)))) + (verbose (single-char #\v)) + (coverage (value optional)))) -(define opts (getopt-long (command-line) options)) -(define to-skip (call-with-input-string (option-ref opts 'skip "") - read)) -(define only (option-ref opts 'only #f)) +(define options (getopt-long (command-line) option-spec)) -(when only (set! files (list only))) +(define coverage-dest (option-ref options 'coverage #f)) -(when (option-ref opts 'verbose #f) +(when (option-ref options 'verbose #f) (verbose? #t)) -(when (list? to-skip) - (for skip in to-skip - (test-skip skip))) + + +(define dir (path-append here "test")) + +(define (file-extension? ext) + (lambda (filename) + (and (<= (string-length ext) (string-length filename)) + (string=? (string-append "." ext) + (string-take-right + filename (1+ (string-length ext))))))) -;; NOTE test-group fails if called before any test begin, since -;; (test-runner-current) needs to be a test-runner (dead or not), -;; but is initially bound to #f. -(test-begin "tests") +(define files (map (lambda (p) (path-append dir p)) + (scandir dir (file-extension? "scm")))) + +;; (format #t "Running on:~%~y~%" files) -;; Forces all warnings to be explicitly handled by tests ((@ (hnh util exceptions) warnings-are-errors) #t) -(define (run-with-coverage) - (with-code-coverage - (lambda () - (for fname in files - (test-group - fname - (with-throw-handler #t - (lambda () - (with-input-from-file (string-append here "/" fname) - (lambda () - (let ((modules (read)) - (forms (read-multiple))) - (eval-in-sandbox - `(begin ,@forms) - #:time-limit 60 ; larger than should be needed - #:allocation-limit #e10e8 - #:module (make-sandbox-module - (append modules - `(((srfi srfi-64) - ,@(module-map - (lambda (n _) n) - (resolve-interface '(srfi srfi-64)))) - ((ice-9 ports) call-with-input-string) - ((guile) make-struct/no-tail)) - all-pure-bindings))) - (list fname modules forms))))) - (lambda (err . args) - (case err - ((misc-error) - (display-error #f (current-error-port) - (car args) - (cadr args) - (caddr args) - #f)) - ((unbound-variable) - (let ((proc (car args)) - (fmt (cadr args)) - (fmt-args (caddr args))) - (format (current-error-port) - "[~a] ~?~%" proc fmt fmt-args))) - (else - (format (current-error-port) - "Test unexpectedly crashed [~a]: ~s~%" err args))) ))))))) - -(use-modules (hnh util path)) -(add-to-load-path (path-append (dirname here) "scripts")) - -(define-values (module-files module-names) - ((@ (all-modules) all-modules-under-directory) - (path-append (dirname here) "module"))) - - -(call-with-values run-with-coverage - (lambda (data _) - - (define to-drop - (1+ (length - (take-while (lambda (p) (not (string=? p "module"))) - (path-split (car module-files)))))) - - (define (drop-components path-list) - (drop path-list to-drop)) - - (define target-ht (make-hash-table)) - (define source-ht ((@@ (system vm coverage) data-file->line-counts) data)) - (for-each (lambda (path) - (cond ((hash-ref source-ht path #f) - => (lambda (value) (hash-set! target-ht path value))))) - (map (compose path-join drop-components path-split) module-files)) - - (let ((better-data - ((@@ (system vm coverage) %make-coverage-data) - ((@@ (system vm coverage) data-ip-counts) data) - ((@@ (system vm coverage) data-sources) data) - ((@@ (system vm coverage) data-file->procedures) data) - target-ht))) - (call-with-output-file "lcov.info" - (lambda (port) (coverage-data->lcov better-data port)))))) - -(test-end "tests") +(define finalizer + (if coverage-dest + (lambda (thunk) + (define-values (coverage _) (with-code-coverage thunk)) + (add-to-load-path (path-append (dirname here) "scripts")) + + (let ((limited-coverage (rework-coverage coverage))) + (call-with-output-file coverage-dest + (lambda (port) (coverage-data->lcov limited-coverage port)))) + + (format #t "Wrote coverage data to ~a~%" coverage-dest)) + (lambda (thunk) (thunk)) + )) + +(test-begin "suite") +(finalizer (lambda () (for-each (lambda (f) (test-group f (load f))) files))) +(test-end "suite") + +(newline) + diff --git a/tests/server.scm b/tests/server.scm deleted file mode 100644 index a2b3ea9d..00000000 --- a/tests/server.scm +++ /dev/null @@ -1,21 +0,0 @@ -;;; Commentary: -;; Tests parse-endpoint-string, used for defining server routes. -;;; Code: - -(((web http make-routes) parse-endpoint-string) - ((hnh util) let*)) - -(test-assert "Check that parsing doesn't crash" - (parse-endpoint-string "/static/:dir/:file")) - -;; Checks that parsing produces correct results -(let* ((path args (parse-endpoint-string "/static/:dir/:file"))) - (test-equal "/static/([^/.]+)/([^/.]+)" path) - (test-equal '(dir file) args)) - - -;; Checks that parsing with custom regex works -;; along with literal periods. -(let* ((path args (parse-endpoint-string "/static/:filename{.*}.:ext"))) - (test-equal "/static/(.*)\\.([^/.]+)" path) - (test-equal '(filename ext) args)) diff --git a/tests/srfi-41-util.scm b/tests/srfi-41-util.scm deleted file mode 100644 index 3c2c3f0f..00000000 --- a/tests/srfi-41-util.scm +++ /dev/null @@ -1,40 +0,0 @@ -;;; Commentary: -;; Tests (srfi srfi-41 util). -;; Currently only tests stream-paginate. -;;; Code: - -(((srfi srfi-41 util) stream-paginate) - ((srfi srfi-41) stream->list stream-ref stream-from - stream-filter stream-car stream) - ((ice-9 sandbox) call-with-time-limit) - ) - -(test-equal "Finite stream" - '((0 1 2) (3 4 5) (6 7 8) (9)) - (let ((strm - (stream-paginate (stream 0 1 2 3 4 5 6 7 8 9) - 3))) - (map stream->list (stream->list strm)))) - - -(test-equal "slice of infinite" - '(1000 1001 1002 1003 1004 1005 1006 1007 1008 1009) - (let ((strm (stream-paginate (stream-from 0)))) - (stream->list (stream-ref strm 100)))) - - - -(define unique-symbol (gensym)) - -(test-equal "time out on infinite 'empty' stream" - unique-symbol - ;; defined outside time limit since creation should always - ;; succeed. Only reference is expected to fail. - (let ((strm (stream-paginate - ;; easy way to get stream which never finds - ;; any elements. - (stream-filter negative? (stream-from 0))))) - (call-with-time-limit - 0.1 - (lambda () (stream-car strm)) - (lambda _ unique-symbol)))) diff --git a/tests/termios.scm b/tests/termios.scm deleted file mode 100644 index e54ddc9c..00000000 --- a/tests/termios.scm +++ /dev/null @@ -1,37 +0,0 @@ -;;; Commentary: -;; Tests that my termios function works, at least somewhat. -;; Note that this actually modifies the terminal it's run on, and might fail -;; if the terminal doesn't support the wanted modes. See termios(3). -;; It might also leave the terminal in a broken state if exited prematurely. -;;; Code: - -(((hnh util) set!) - ((vulgar termios) - make-termios copy-termios - lflag - tcgetattr! tcsetattr! - ECHO ICANON) - ((srfi srfi-60) - (bitwise-ior . ||) - (bitwise-not . ~) - (bitwise-and . &)) - ((guile) open-input-file)) - -(define tty (open-input-file "/dev/tty")) - -(define-syntax-rule (&= lvalue val) - (set! lvalue = ((lambda (v) (& v val))))) - -(define t (make-termios)) - -(test-equal 0 (tcgetattr! t tty)) -(define ifl (lflag t)) - -(define copy (copy-termios t)) - -#!curly-infix { (lflag t) &= (~ (|| ECHO ICANON)) } - -(test-equal 0 (tcsetattr! t tty)) -(test-equal (& ifl (~ (|| ECHO ICANON))) - (lflag t)) -(test-equal 0 (tcsetattr! copy tty)) diff --git a/tests/test/annoying-events.scm b/tests/test/annoying-events.scm new file mode 100644 index 00000000..4570a5a6 --- /dev/null +++ b/tests/test/annoying-events.scm @@ -0,0 +1,75 @@ +(define-module (test annoying-events) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((srfi srfi-41 util) + :select (filter-sorted-stream)) + :use-module ((srfi srfi-41) + :select (stream + stream->list + stream-filter + stream-take-while)) + :use-module ((vcomponent base) + :select (extract prop make-vcomponent)) + :use-module ((vcomponent datetime) :select (event-overlaps?)) + :use-module ((datetime) :select (date date+ date<)) + :use-module ((hnh util) :select (set!))) + +(define* (event key: summary dtstart dtend) + (define ev (make-vcomponent 'VEVENT)) + (set! (prop ev 'SUMMARY) + summary + (prop ev 'DTSTART) + dtstart + (prop ev 'DTEND) + dtend) + ev) + +(define start + #2021-11-01) + +(define end (date+ start (date day: 8))) + +(define ev-set + (stream + (event ; should be part of the result + summary: "A" + dtstart: #2021-10-01 + dtend: #2021-12-01) + (event ; should NOT be part of the result + summary: "B" + dtstart: #2021-10-10 + dtend: #2021-10-11) + (event ; should also be part of the result + summary: "C" + dtstart: #2021-11-02 + dtend: #2021-11-03))) + +;; (if (and (date< (prop ev 'DTSTART) start-date) +;; (date<= (prop ev 'DTEND) end-date)) +;; ;; event will be picked, but next event might have +;; (and (date< start-date (prop ev 'DTSTART)) +;; (date< end-date (prop ev 'DTEND))) +;; ;; meaning that it wont be added, stopping filter-sorted-stream +;; ) + +;; The naïve way to get all events in an interval. Misses C due to B being "in the way" + +(test-equal "incorrect handling of non-contigious" + '("A" #; "C") + (map (extract 'SUMMARY) + (stream->list + (filter-sorted-stream + (lambda (ev) (event-overlaps? ev start (date+ start (date day: 8)))) + ev-set)))) + +(test-equal "correct handling of non-contigious" + '("A" "C") + (map (extract 'SUMMARY) + (stream->list + (stream-filter + (lambda (ev) (event-overlaps? ev start end)) + (stream-take-while + (lambda (ev) (date< (prop ev 'DTSTART) end)) + ev-set))))) + + diff --git a/tests/test/base64.scm b/tests/test/base64.scm new file mode 100644 index 00000000..3463432e --- /dev/null +++ b/tests/test/base64.scm @@ -0,0 +1,24 @@ +;;; Commentary: +;; Test that Base64 encoding and decoding works +;; Examples from RFC4648 +;;; Code: + +(define-module (test base64) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((base64) :select (base64encode base64decode))) + +(test-equal "" (base64encode "")) +(test-equal "Zg==" (base64encode "f")) +(test-equal "Zm8=" (base64encode "fo")) +(test-equal "Zm9v" (base64encode "foo")) +(test-equal "Zm9vYg==" (base64encode "foob")) +(test-equal "Zm9vYmE=" (base64encode "fooba")) +(test-equal "Zm9vYmFy" (base64encode "foobar")) +(test-equal "" (base64decode "")) +(test-equal "f" (base64decode "Zg==")) +(test-equal "fo" (base64decode "Zm8=")) +(test-equal "foo" (base64decode "Zm9v")) +(test-equal "foob" (base64decode "Zm9vYg==")) +(test-equal "fooba" (base64decode "Zm9vYmE=")) +(test-equal "foobar" (base64decode "Zm9vYmFy")) diff --git a/tests/test/cpp.scm b/tests/test/cpp.scm new file mode 100644 index 00000000..9c720fde --- /dev/null +++ b/tests/test/cpp.scm @@ -0,0 +1,39 @@ +;;; Commentary: +;; Tests my parser for a subset of the C programming language. +;;; Code: + +(define-module (test cpp) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((c lex) :select (lex)) + :use-module ((c parse) :select (parse-lexeme-tree))) + +(define run (compose parse-lexeme-tree lex)) + +(test-equal + '(+ (post-increment (dereference C)) 3) + (run "(*C)++ + 3")) + +(test-equal + '(+ (post-increment (dereference C)) 3) + (run "*C++ + 3")) + +(test-equal + '(post-increment (dereference C)) + (run "*C++")) + +(test-equal + '(+ (post-increment C) (post-increment C)) + (run "C++ + C++")) + +(test-equal + '(+ (pre-increment C) (pre-increment C)) + (run "++C + ++C")) + +(test-equal '(+ 2 (* 2 2)) (run "2 + 2 * 2")) + +(test-equal '(+ (* 2 2) 2) (run "2 * 2 + 2")) + +(test-equal '(+ 2 2 2) (run "2+2+2")) + + diff --git a/tests/test/datetime-compare.scm b/tests/test/datetime-compare.scm new file mode 100644 index 00000000..0d07c52f --- /dev/null +++ b/tests/test/datetime-compare.scm @@ -0,0 +1,145 @@ +;;; Commentary: +;; Tests that all ordering predicates for dates, +;; times, and datetimes hold. +;;; Code: + +(define-module (test datetime-compare) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((datetime) + :select (date datetime + time + date< + date<= + date> + date>= + date/-time< + time<))) + +(test-assert "date< empty" (date<)) + +(test-assert + "date< single" + (date< #2020-01-10)) + +(test-assert + "date< double" + (date< #2020-01-10 + #2020-01-11)) + +(test-assert + "date< tripple" + (date< #2020-01-10 + #2020-01-11 + #2020-01-12)) + +(test-assert + "date< tripple negate" + (not (date< #2020-01-10 + #2020-01-12 + #2020-01-11))) + +(test-assert "date<= empty" (date<=)) + +(test-assert + "date<= single" + (date<= #2020-01-10)) + +(test-assert + "date<= double" + (date<= + #2020-01-10 + #2020-01-11)) + +(test-assert + "date<=" + (not (date<= + #2020-01-01 + #2018-05-15 + #2020-01-31))) + +(test-assert + "date<= equal" + (date<= + #2018-05-15 + #2018-05-15)) + +(test-assert + "date<" + (not (date< #2020-01-01 + #2018-05-15 + #2020-01-31))) + +(test-assert + "date>" + (not (date> #2020-01-31 + #2018-05-15 + #2020-01-01))) + +(test-assert + "date>=" + (not (date>= + #2020-01-31 + #2018-05-15 + #2020-01-01))) + +(test-assert + "time< simple" + (time< #05:00:00 + #10:00:00)) + +(test-assert + "time<" + (time< (time) + #10:00:00)) + +(test-assert + "date/-time<" + (date/-time< + #2020-01-01 + #2020-01-02)) + +(test-assert + "not date/-time<" + (not (date/-time< + #2020-01-01 + #2020-01-01))) + +(test-assert + "date/-time< only other dt" + (date/-time< + #2020-01-01 + #2020-01-02T10:00:00)) + +(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)) + +(test-assert + (not (date/-time< + #2018-11-30T08:10:00 + #2014-04-13T16:00:00))) + + diff --git a/tests/test/datetime-util.scm b/tests/test/datetime-util.scm new file mode 100644 index 00000000..ca8a9241 --- /dev/null +++ b/tests/test/datetime-util.scm @@ -0,0 +1,182 @@ +;;; Commentary: +;; Tests timespan overlaps and month-streams. +;; Separate from tests/datetime.scm since +;; (datetime util) originally was its own module. +;;; Code: + +(define-module (test datetime-util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((datetime) + :select (date time + datetime + month-stream + in-date-range? + timespan-overlaps?)) + :use-module ((srfi srfi-41) + :select (stream->list stream-take))) + +(test-assert + "jan->dec" + (stream->list + (stream-take + 11 + (month-stream + #2020-01-01)))) + +(test-assert + "dec->jan" + (stream->list + (stream-take + 2 + (month-stream + #2020-12-01)))) + +(test-assert + "dec->feb" + (stream->list + (stream-take + 3 + (month-stream + #2020-12-01)))) + +(test-assert + "20 months" + (stream->list + (stream-take + 20 + (month-stream + #2020-01-01)))) + +(test-equal + "Correct months" + (list #2020-02-01 + #2020-03-01 + #2020-04-01 + #2020-05-01 + #2020-06-01 + #2020-07-01 + #2020-08-01 + #2020-09-01 + #2020-10-01 + #2020-11-01 + #2020-12-01 + #2021-01-01) + (stream->list + (stream-take + 12 + (month-stream + #2020-02-01)))) + +(test-assert + "in-date-range?" + (not ((in-date-range? + #2020-01-01 + #2020-02-29) + #2018-02-02))) + +(test-assert + "A" + (timespan-overlaps? + #2020-01-01 + #2020-01-10 + #2020-01-05 + #2020-01-15)) + +(test-assert + "A, shared start" + (timespan-overlaps? + #2020-01-01 + #2020-01-10 + #2020-01-01 + #2020-01-15)) + +(test-assert + "A, tangential" + (not (timespan-overlaps? + #2020-01-01T00:00:00 + #2020-01-10T00:00:00 + #2020-01-10T00:00:00 + #2020-01-30T00:00:00))) + +(test-assert + "s1 instant" + (timespan-overlaps? + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-10T00:00:00 + #2020-01-30T00:00:00)) + +(test-assert + "s2 instant" + (timespan-overlaps? + #2020-01-10T00:00:00 + #2020-01-30T00:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00)) + +(test-assert + "s1 instant, shared start with s2" + (timespan-overlaps? + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-30T00:00:00)) + +(test-assert + "s1 instant, shared end with s2" + (not (timespan-overlaps? + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-10T00:00:00 + #2020-01-15T10:00:00))) + +(test-assert + "s2 instant, shared start with s1" + (timespan-overlaps? + #2020-01-15T10:00:00 + #2020-01-30T00:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00)) + +(test-assert + "s2 instant, shared end with s1" + (not (timespan-overlaps? + #2020-01-10T00:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00))) + +(test-assert + "both instant" + (not (timespan-overlaps? + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00 + #2020-01-15T10:00:00))) + +(test-assert + "tangential whole day" + (not (timespan-overlaps? + #2020-01-01 + #2020-01-02 + #2020-01-02 + #2020-01-03))) + +(test-assert + "B" + (timespan-overlaps? + #2020-01-05 + #2020-01-15 + #2020-01-01 + #2020-01-10)) + +(test-assert + "E" + (timespan-overlaps? + #2020-01-01 + #2020-01-10 + #2020-01-01 + #2020-01-10)) + + diff --git a/tests/test/datetime.scm b/tests/test/datetime.scm new file mode 100644 index 00000000..1051e203 --- /dev/null +++ b/tests/test/datetime.scm @@ -0,0 +1,395 @@ +;;; Commentary: +;; Tests date, time, and datetime creation, +;; (output) formatting, and arithmetic. +;;; Code: + +(define-module (test datetime) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((datetime) + :select (date+ date- + time+ + time- + year + month + day + date + time + datetime + datetime+ + datetime<=? + datetime-difference + datetime- + leap-year? + string->date + string->time + string->datetime + parse-month + days-in-interval)) + :use-module ((ice-9 format) :select (format)) + :use-module ((hnh util) :select (let*)) + :use-module ((ice-9 i18n) :select (make-locale)) + :use-module ((guile) :select (LC_TIME))) + +(test-equal + "empty time" + (time) + #00:00:00) + +(test-assert + "Synatx date" + #2020-01-01) + +(test-assert + "Test year type" + (integer? (year (date year: 2020)))) + +(test-assert + "Test mmnth type" + (integer? (month (date month: 1)))) + +(test-assert + "Test day type" + (integer? (day (date day: 1)))) + +(test-equal + "Manual print (any)" + "2020-10-10" + (let ((d #2020-10-10)) + (format #f "~a-~a-~a" (year d) (month d) (day d)))) + +(test-equal + "Manual print (number)" + "2020-10-10" + (let ((d #2020-10-10)) + (format #f "~d-~d-~d" (year d) (month d) (day d)))) + +(test-equal + "Date print" + "#2020-01-01" + (format + #f + "~a" + #2020-01-01)) + +(test-equal + "Syntax date=" + (date year: 2020 month: 1 day: 1) + #2020-01-01) + +(test-equal + "Syntax time=" + (time hour: 13 minute: 37 second: 0) + #13:37:00) + +(test-equal + "Syntax Datetime=" + (datetime year: 2020 month: 1 day: 1 + hour: 13 minute: 37 second: 0) + #2020-01-01T13:37:00) + +(test-equal + #2020-02-28 + (date- #2020-03-05 + (date day: 6))) + +(test-equal + #2020-02-29 + (date- #2020-03-05 + (date day: 5))) + +(test-equal + #2020-03-01 + (date- #2020-03-05 + (date day: 4))) + +(test-equal + "date+ day" + #2020-10-10 + (date+ #2020-10-01 + (date day: 9))) + +(test-equal + "date+ month" + #2020-10-10 + (date+ #2020-01-10 + (date month: 9))) + +(test-equal + "date+ day/month" + #2020-10-10 + (date+ #2020-01-01 + (date day: 9 month: 9))) + +(test-assert + "date+ first literal" + (date+ #2020-01-01 + (date day: 0))) + +(test-assert + "date+ second literal" + (date+ #0001-01-01 + #0001-00-00)) + +(test-assert + "date+ both literal" + (date+ #2020-01-01 + #0000-00-00)) + +(test-equal + "date+ year overflow" + #2019-01-01 + (date+ #2018-12-31 + (date day: 1))) + +(test-equal + "date- year overflow" + #2018-12-31 + (date- #2019-01-01 + (date day: 1))) + +(test-equal + "date- large" + #0001-01-01 + (date- #2020-01-01 + #2019-00-00)) + +(test-equal + "date- equal" + (date year: -1 month: 11 day: 31) + (date- #2020-01-01 + #2020-01-01)) + +(test-equal + #2020-01-01T10:00:00 + (datetime + date: + #2020-01-01 + time: + #10:00:00)) + +(test-equal + #2020-01-01T10:00:00 + (datetime+ + (datetime + date: + #2020-01-01) + (datetime + time: + #10:00:00))) + +(test-equal + #2020-10-09T14:00:00 + (datetime- + #2020-10-10T00:00:00 + (datetime + time: + #10:00:00))) + +(test-equal + #2020-09-24T14:00:00 + (datetime- + #2020-10-10T00:00:00 + #0000-00-15T10:00:00)) + +(test-equal + #2020-03-10 + (date+ #2020-03-01 + (date day: 4) + (date day: 5))) + +(let* ((diff overflow + (time- #10:20:30 + #10:20:30))) + (test-equal + "time- self" + #00:00:00 + diff) + (test-equal "time- self overflow" 0 overflow)) + +(let* ((diff overflow + (time- #10:00:00 + #10:00:01))) + (test-equal + "time- overflow 1s" + #23:59:59 + diff) + (test-equal + "time- overflow 1s overflow" + 1 + overflow)) + +(let* ((diff overflow + (time- #10:00:00 + (time hour: (+ 48 4))))) + (test-equal + "time- overflow multiple" + #06:00:00 + diff) + (test-equal + "time- overflow multiple overflow" + 2 + overflow)) + +(test-equal + "datetime-difference self" + #0000-00-00T00:00:00 + (datetime-difference + (datetime + date: + #2020-01-01) + (datetime + date: + #2020-01-01))) + +;; NOTE +;; at the time of writing this returns #2020-02-00 +;; The general question is, how is the last in a month handled? +(test-equal + #2020-01-31 + (date+ #2019-12-31 + (date month: 1))) + +(test-assert (leap-year? 2020)) + +(test-equal + "Add to Leap day" + #2020-02-29 + (date+ #2020-02-28 + (date day: 1))) + +(test-equal + "Parse ISO" + #2021-12-30T13:53:33 + (string->datetime + "2021-12-30T13:53:33" + "~Y-~m-~dT~H:~M:~S")) + +(test-equal + "Parse ical date-time" + #2021-12-30T13:53:33 + (string->datetime + "20211230T135333" + "~Y~m~dT~H~M~S")) + +(test-equal + "Parse single hour (padded)" + (time hour: 5) + (string->time "05" "~H")) + +(test-equal + "Parse single hour (non-padded)" + (time hour: 5) + (string->time "5" "~H")) + +(test-equal + "Parse month (swedish)" + (date month: 5) + (string->date + "Maj" + "~b" + (make-locale LC_TIME "sv_SE.UTF-8"))) + +(test-equal + "Parse month (english)" + (date month: 5) + (string->date + "May" + "~b" + (make-locale LC_TIME "en_US.UTF-8"))) + +(test-equal + "AM/PM AM" + (time hour: 10) + (string->time "10 AM" "~H ~p")) + +(test-equal + "AM/PM PM" + (time hour: 22) + (string->time "10 PM" "~H ~p")) + +(test-equal + "AM/PM AM 12" + (time hour: 0) + (string->time "12 AM" "~H ~p")) + +(test-equal + "AM/PM PM 12" + (time hour: 12) + (string->time "12 PM" "~H ~p")) + +(test-equal + "AM/PM PM (prefix)" + (time hour: 22) + (string->time "PM 10" "~p ~H")) + +(test-equal + "Parse complicated 1" + #2021-12-30T10:56:00 + (string->datetime + "Dec. 30, 2021, 10:56" + "~b. ~d, ~Y, ~H:~M" + (make-locale LC_TIME "en_US.UTF-8"))) + +(test-equal + "Parse complicated 2" + #2021-12-30T10:56:00 + (string->datetime + "Dec. 30, 2021, 10:56 a.m." + "~b. ~d, ~Y, ~H:~M" + (make-locale LC_TIME "en_US.UTF-8"))) + +(test-equal + "Parse complicated 3" + #2021-12-30T22:56:00 + (string->datetime + "Dec. 30, 2021, 10:56 p.m." + "~b. ~d, ~Y, ~H:~M ~p" + (make-locale LC_TIME "en_US.UTF-8"))) + +(test-equal + "Parse date single digit day" + (date day: 6) + (string->date "6" "~d")) + +(test-equal + "Parse date single digit day, trailing comma" + (date day: 6) + (string->date "6," "~d,")) + +(test-equal + "Parse date single digit day, trailing comma + space" + (date day: 6) + (string->date "6, " "~d, ")) + +(define en_US + (make-locale LC_TIME "en_US.UTF-8")) + +(define sv_SE + (make-locale LC_TIME "sv_SE.UTF-8")) + +(test-equal 1 (parse-month "jan" en_US)) + +(test-equal 1 (parse-month "jan" sv_SE)) + +(test-equal 12 (parse-month "dec" en_US)) + +(test-equal -1 (parse-month "inv" en_US)) + +(test-equal 5 (parse-month "mAJ" sv_SE)) + +(test-equal + "Days in regular year" + 365 + (days-in-interval + #2021-01-01 + #2021-12-31)) + +(test-equal + "Days in leap year" + 366 + (days-in-interval + #2020-01-01 + #2020-12-31)) + + diff --git a/tests/test/let-env.scm b/tests/test/let-env.scm new file mode 100644 index 00000000..1d6d7507 --- /dev/null +++ b/tests/test/let-env.scm @@ -0,0 +1,42 @@ +(define-module (test let-env) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((guile) :select (setenv getenv)) + :use-module ((hnh util) :select (let-env))) + +(setenv "CALP_TEST_ENV" "1") + +(test-equal + "Ensure we have set value beforehand" + "1" + (getenv "CALP_TEST_ENV")) + +(let-env + ((CALP_TEST_ENV "2")) + (test-equal + "Test our local override" + "2" + (getenv "CALP_TEST_ENV"))) + +(test-equal + "Test that we have returned" + "1" + (getenv "CALP_TEST_ENV")) + +(catch 'test-error + (lambda () + (let-env + ((CALP_TEST_ENV "2")) + (test-equal + "Test our local override again" + "2" + (getenv "CALP_TEST_ENV")) + (throw 'test-error))) + list) + +(test-equal + "Test restoration after non-local exit" + "1" + (getenv "CALP_TEST_ENV")) + + diff --git a/tests/test/let.scm b/tests/test/let.scm new file mode 100644 index 00000000..5312409e --- /dev/null +++ b/tests/test/let.scm @@ -0,0 +1,45 @@ +;;; Commentary: +;; Tests my custom let*. +;;; Code: + +(define-module (test let) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((hnh util) :select (let*))) + +(test-assert (let* ((a #t)) a)) + +(test-assert (let* (((a . b) (cons #t #f))) a)) + +(test-assert (let* (((a . b) (cons* #f #t))) b)) + +(test-assert + (let* ((a b c (values #f #t #f))) b)) + +(test-assert + (let* (((a b c) (list #f #t #f))) b)) + +(test-assert (let* (((a) '(#t))) a)) + +(test-equal '(2) (let* (((a . b) '(1 2))) b)) + +(test-equal + '(3 4) + (let* (((a b . c) '(1 2 3 4))) c)) + +(test-equal 10 (let* (x) (set! x 10) x)) + +(test-equal + 30 + (let* (x y) (set! x 10) (set! y 20) (+ x y))) + +(test-assert (let* (x) (not x))) + +(test-equal + 6 + (let* ((x 1) y z) + (set! y 2) + (set! z 3) + (+ x y z))) + + diff --git a/tests/test/param.scm b/tests/test/param.scm new file mode 100644 index 00000000..8b8a010d --- /dev/null +++ b/tests/test/param.scm @@ -0,0 +1,57 @@ +;;; Commentary: +;; Checks that parameters (1) are correctly parsed and stored. +;; (1): 'A', and 'B' in the line "KEY;A=1;B=2:Some text" +;;; Code: + +(define-module (test param) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent base) + :select (param prop* parameters prop)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((vcomponent) :select (make-vcomponent)) + :use-module ((hnh util) :select (sort* set!)) + :use-module ((ice-9 ports) :select (call-with-input-string)) + :use-module ((vcomponent formats xcal output) + :select (vcomponent->sxcal)) + ) + +(define v + (call-with-input-string + "BEGIN:DUMMY +X-KEY;A=1;B=2:Some text +END:DUMMY" + parse-calendar)) + +(test-equal '("1") (param (prop* v 'X-KEY) 'A)) + +(test-equal '("2") (param (prop* v 'X-KEY) 'B)) + +(test-equal #f (param (prop* v 'X-KEY) 'C)) + +(test-equal + '(A B) + (sort* (map car (parameters (prop* v 'X-KEY))) + stringstring)) + + +;; TODO possibly move this. +;; Checks that a warning is properly raised for +;; unkonwn keys (without an X-prefix) +(test-error + 'warning + (call-with-input-string + "BEGIN:DUMMY +KEY:Some Text +END:DUMMY")) + +;; Similar thing happens for sxcal, but during serialization instead +(let ((component (make-vcomponent 'DUMMY))) + (set! (prop component 'KEY) "Anything") + (test-error + 'warning + (vcomponent->sxcal component))) + + diff --git a/tests/test/recurrence-advanced.scm b/tests/test/recurrence-advanced.scm new file mode 100644 index 00000000..9ea1e075 --- /dev/null +++ b/tests/test/recurrence-advanced.scm @@ -0,0 +1,1347 @@ +;;; Commentary: +;; Tests of recurrence rule generation with focus on correct instances +;; being generated. For tests of basic recurrence functionallity, see +;; recurrence-simple.scm. +;; +;; This file also tests format-recurrence-rule, which checks that human +;; readable representations of the RRULES work. +;; +;; Also contains the tests for EXDATE. +;; +;; Most examples copied from RFC5545, some home written. +;;; Code: + +(define-module (test recurrence-advanced) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent recurrence parse) + :select (parse-recurrence-rule)) + :use-module ((vcomponent recurrence generate) + :select (generate-recurrence-set)) + :use-module ((vcomponent recurrence display) + :select (format-recurrence-rule)) + :use-module ((vcomponent recurrence internal) + :select (count until)) + :use-module ((vcomponent base) + :select (make-vcomponent prop prop* extract)) + :use-module ((datetime) + :select (parse-ics-datetime + datetime + time + date + datetime->string)) + :use-module ((hnh util) :select (-> set!)) + :use-module ((srfi srfi-41) :select (stream->list)) + :use-module ((srfi srfi-88) :select (keyword->string))) + +(test-expect-fail "RSET: The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months") + +(test-expect-fail "STR: The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months") + +(test-expect-fail "RSET: The second-to-last weekday of the month") + +(test-expect-fail "STR: The second-to-last weekday of the month") + +;; TODO this test is really slow, figure out why (takes approx. 25s to run) +(test-skip "RSET: Every day in January, for 3 years (alt 2)") + +(define (run-test comp) + (test-equal + (string-append "RSET: " (prop comp 'SUMMARY)) + (prop comp 'X-SET) + (let ((r (generate-recurrence-set comp))) + (map (extract 'DTSTART) + (if (or (until (prop comp 'RRULE)) + (count (prop comp 'RRULE))) + (stream->list r) + (stream->list 20 r))))) + (test-equal + (string-append "STR: " (prop comp 'SUMMARY)) + (prop comp 'X-SUMMARY) + (format-recurrence-rule (prop comp 'RRULE)))) + +(define (vevent . rest) + (define v (make-vcomponent 'VEVENT)) + (let loop ((rem rest)) + (unless + (null? rem) + (let ((symb (-> (car rem) + keyword->string + string-upcase + string->symbol))) + (set! (prop v symb) + (case symb + ((DTSTART EXDATE) + (parse-ics-datetime (cadr rem))) + ((RRULE) (parse-recurrence-rule (cadr rem))) + (else (cadr rem)))) + (when (eq? symb 'EXDATE) + (set! (prop* v symb) = list))) + (loop (cddr rem)))) + v) + +(map run-test + (list (vevent + summary: + "Daily for 10 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=DAILY;COUNT=10" + x-summary: + "dagligen, totalt 10 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-03T09:00:00 + #1997-09-04T09:00:00 + #1997-09-05T09:00:00 + #1997-09-06T09:00:00 + #1997-09-07T09:00:00 + #1997-09-08T09:00:00 + #1997-09-09T09:00:00 + #1997-09-10T09:00:00 + #1997-09-11T09:00:00)) + (vevent + summary: + "Daily until December 24, 1997" + dtstart: + "19970902T090000" + rrule: + "FREQ=DAILY;UNTIL=19971224T000000Z" + x-summary: + "dagligen, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-03T09:00:00 + #1997-09-04T09:00:00 + #1997-09-05T09:00:00 + #1997-09-06T09:00:00 + #1997-09-07T09:00:00 + #1997-09-08T09:00:00 + #1997-09-09T09:00:00 + #1997-09-10T09:00:00 + #1997-09-11T09:00:00 + #1997-09-12T09:00:00 + #1997-09-13T09:00:00 + #1997-09-14T09:00:00 + #1997-09-15T09:00:00 + #1997-09-16T09:00:00 + #1997-09-17T09:00:00 + #1997-09-18T09:00:00 + #1997-09-19T09:00:00 + #1997-09-20T09:00:00 + #1997-09-21T09:00:00 + #1997-09-22T09:00:00 + #1997-09-23T09:00:00 + #1997-09-24T09:00:00 + #1997-09-25T09:00:00 + #1997-09-26T09:00:00 + #1997-09-27T09:00:00 + #1997-09-28T09:00:00 + #1997-09-29T09:00:00 + #1997-09-30T09:00:00 + #1997-10-01T09:00:00 + #1997-10-02T09:00:00 + #1997-10-03T09:00:00 + #1997-10-04T09:00:00 + #1997-10-05T09:00:00 + #1997-10-06T09:00:00 + #1997-10-07T09:00:00 + #1997-10-08T09:00:00 + #1997-10-09T09:00:00 + #1997-10-10T09:00:00 + #1997-10-11T09:00:00 + #1997-10-12T09:00:00 + #1997-10-13T09:00:00 + #1997-10-14T09:00:00 + #1997-10-15T09:00:00 + #1997-10-16T09:00:00 + #1997-10-17T09:00:00 + #1997-10-18T09:00:00 + #1997-10-19T09:00:00 + #1997-10-20T09:00:00 + #1997-10-21T09:00:00 + #1997-10-22T09:00:00 + #1997-10-23T09:00:00 + #1997-10-24T09:00:00 + #1997-10-25T09:00:00 + #1997-10-26T09:00:00 + #1997-10-27T09:00:00 + #1997-10-28T09:00:00 + #1997-10-29T09:00:00 + #1997-10-30T09:00:00 + #1997-10-31T09:00:00 + #1997-11-01T09:00:00 + #1997-11-02T09:00:00 + #1997-11-03T09:00:00 + #1997-11-04T09:00:00 + #1997-11-05T09:00:00 + #1997-11-06T09:00:00 + #1997-11-07T09:00:00 + #1997-11-08T09:00:00 + #1997-11-09T09:00:00 + #1997-11-10T09:00:00 + #1997-11-11T09:00:00 + #1997-11-12T09:00:00 + #1997-11-13T09:00:00 + #1997-11-14T09:00:00 + #1997-11-15T09:00:00 + #1997-11-16T09:00:00 + #1997-11-17T09:00:00 + #1997-11-18T09:00:00 + #1997-11-19T09:00:00 + #1997-11-20T09:00:00 + #1997-11-21T09:00:00 + #1997-11-22T09:00:00 + #1997-11-23T09:00:00 + #1997-11-24T09:00:00 + #1997-11-25T09:00:00 + #1997-11-26T09:00:00 + #1997-11-27T09:00:00 + #1997-11-28T09:00:00 + #1997-11-29T09:00:00 + #1997-11-30T09:00:00 + #1997-12-01T09:00:00 + #1997-12-02T09:00:00 + #1997-12-03T09:00:00 + #1997-12-04T09:00:00 + #1997-12-05T09:00:00 + #1997-12-06T09:00:00 + #1997-12-07T09:00:00 + #1997-12-08T09:00:00 + #1997-12-09T09:00:00 + #1997-12-10T09:00:00 + #1997-12-11T09:00:00 + #1997-12-12T09:00:00 + #1997-12-13T09:00:00 + #1997-12-14T09:00:00 + #1997-12-15T09:00:00 + #1997-12-16T09:00:00 + #1997-12-17T09:00:00 + #1997-12-18T09:00:00 + #1997-12-19T09:00:00 + #1997-12-20T09:00:00 + #1997-12-21T09:00:00 + #1997-12-22T09:00:00 + #1997-12-23T09:00:00)) + (vevent + summary: + "Every other day - forever" + dtstart: + "19970902T090000" + rrule: + "FREQ=DAILY;INTERVAL=2" + x-summary: + "varannan dag" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-04T09:00:00 + #1997-09-06T09:00:00 + #1997-09-08T09:00:00 + #1997-09-10T09:00:00 + #1997-09-12T09:00:00 + #1997-09-14T09:00:00 + #1997-09-16T09:00:00 + #1997-09-18T09:00:00 + #1997-09-20T09:00:00 + #1997-09-22T09:00:00 + #1997-09-24T09:00:00 + #1997-09-26T09:00:00 + #1997-09-28T09:00:00 + #1997-09-30T09:00:00 + #1997-10-02T09:00:00 + #1997-10-04T09:00:00 + #1997-10-06T09:00:00 + #1997-10-08T09:00:00 + #1997-10-10T09:00:00)) + (vevent + summary: + "Every 10 days, 5 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=DAILY;INTERVAL=10;COUNT=5" + x-summary: + "var tionde dag, totalt 5 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-12T09:00:00 + #1997-09-22T09:00:00 + #1997-10-02T09:00:00 + #1997-10-12T09:00:00)) + (vevent + summary: + "Every day in January, for 3 years (alt 1)" + dtstart: + "19980101T090000" + rrule: + "FREQ=YEARLY;UNTIL=20000131T140000Z;BYMONTH=1;BYDAY=SU,MO,TU,WE,TH,FR,SA" + x-summary: + "varje lördag, fredag, torsdag, onsdag, tisdag, måndag & söndag i januari, årligen, till och med den 31 januari, 2000 kl. 14:00" + x-set: + (list #1998-01-01T09:00:00 + #1998-01-02T09:00:00 + #1998-01-03T09:00:00 + #1998-01-04T09:00:00 + #1998-01-05T09:00:00 + #1998-01-06T09:00:00 + #1998-01-07T09:00:00 + #1998-01-08T09:00:00 + #1998-01-09T09:00:00 + #1998-01-10T09:00:00 + #1998-01-11T09:00:00 + #1998-01-12T09:00:00 + #1998-01-13T09:00:00 + #1998-01-14T09:00:00 + #1998-01-15T09:00:00 + #1998-01-16T09:00:00 + #1998-01-17T09:00:00 + #1998-01-18T09:00:00 + #1998-01-19T09:00:00 + #1998-01-20T09:00:00 + #1998-01-21T09:00:00 + #1998-01-22T09:00:00 + #1998-01-23T09:00:00 + #1998-01-24T09:00:00 + #1998-01-25T09:00:00 + #1998-01-26T09:00:00 + #1998-01-27T09:00:00 + #1998-01-28T09:00:00 + #1998-01-29T09:00:00 + #1998-01-30T09:00:00 + #1998-01-31T09:00:00 + #1999-01-01T09:00:00 + #1999-01-02T09:00:00 + #1999-01-03T09:00:00 + #1999-01-04T09:00:00 + #1999-01-05T09:00:00 + #1999-01-06T09:00:00 + #1999-01-07T09:00:00 + #1999-01-08T09:00:00 + #1999-01-09T09:00:00 + #1999-01-10T09:00:00 + #1999-01-11T09:00:00 + #1999-01-12T09:00:00 + #1999-01-13T09:00:00 + #1999-01-14T09:00:00 + #1999-01-15T09:00:00 + #1999-01-16T09:00:00 + #1999-01-17T09:00:00 + #1999-01-18T09:00:00 + #1999-01-19T09:00:00 + #1999-01-20T09:00:00 + #1999-01-21T09:00:00 + #1999-01-22T09:00:00 + #1999-01-23T09:00:00 + #1999-01-24T09:00:00 + #1999-01-25T09:00:00 + #1999-01-26T09:00:00 + #1999-01-27T09:00:00 + #1999-01-28T09:00:00 + #1999-01-29T09:00:00 + #1999-01-30T09:00:00 + #1999-01-31T09:00:00 + #2000-01-01T09:00:00 + #2000-01-02T09:00:00 + #2000-01-03T09:00:00 + #2000-01-04T09:00:00 + #2000-01-05T09:00:00 + #2000-01-06T09:00:00 + #2000-01-07T09:00:00 + #2000-01-08T09:00:00 + #2000-01-09T09:00:00 + #2000-01-10T09:00:00 + #2000-01-11T09:00:00 + #2000-01-12T09:00:00 + #2000-01-13T09:00:00 + #2000-01-14T09:00:00 + #2000-01-15T09:00:00 + #2000-01-16T09:00:00 + #2000-01-17T09:00:00 + #2000-01-18T09:00:00 + #2000-01-19T09:00:00 + #2000-01-20T09:00:00 + #2000-01-21T09:00:00 + #2000-01-22T09:00:00 + #2000-01-23T09:00:00 + #2000-01-24T09:00:00 + #2000-01-25T09:00:00 + #2000-01-26T09:00:00 + #2000-01-27T09:00:00 + #2000-01-28T09:00:00 + #2000-01-29T09:00:00 + #2000-01-30T09:00:00 + #2000-01-31T09:00:00)) + (vevent + summary: + "Every day in January, for 3 years (alt 2)" + dtstart: + "19980101T090000" + rrule: + "FREQ=DAILY;UNTIL=20000131T140000Z;BYMONTH=1" + x-summary: + "dagligen, till och med den 31 januari, 2000 kl. 14:00" + x-set: + (list #1998-01-01T09:00:00 + #1998-01-02T09:00:00 + #1998-01-03T09:00:00 + #1998-01-04T09:00:00 + #1998-01-05T09:00:00 + #1998-01-06T09:00:00 + #1998-01-07T09:00:00 + #1998-01-08T09:00:00 + #1998-01-09T09:00:00 + #1998-01-10T09:00:00 + #1998-01-11T09:00:00 + #1998-01-12T09:00:00 + #1998-01-13T09:00:00 + #1998-01-14T09:00:00 + #1998-01-15T09:00:00 + #1998-01-16T09:00:00 + #1998-01-17T09:00:00 + #1998-01-18T09:00:00 + #1998-01-19T09:00:00 + #1998-01-20T09:00:00 + #1998-01-21T09:00:00 + #1998-01-22T09:00:00 + #1998-01-23T09:00:00 + #1998-01-24T09:00:00 + #1998-01-25T09:00:00 + #1998-01-26T09:00:00 + #1998-01-27T09:00:00 + #1998-01-28T09:00:00 + #1998-01-29T09:00:00 + #1998-01-30T09:00:00 + #1998-01-31T09:00:00 + #1999-01-01T09:00:00 + #1999-01-02T09:00:00 + #1999-01-03T09:00:00 + #1999-01-04T09:00:00 + #1999-01-05T09:00:00 + #1999-01-06T09:00:00 + #1999-01-07T09:00:00 + #1999-01-08T09:00:00 + #1999-01-09T09:00:00 + #1999-01-10T09:00:00 + #1999-01-11T09:00:00 + #1999-01-12T09:00:00 + #1999-01-13T09:00:00 + #1999-01-14T09:00:00 + #1999-01-15T09:00:00 + #1999-01-16T09:00:00 + #1999-01-17T09:00:00 + #1999-01-18T09:00:00 + #1999-01-19T09:00:00 + #1999-01-20T09:00:00 + #1999-01-21T09:00:00 + #1999-01-22T09:00:00 + #1999-01-23T09:00:00 + #1999-01-24T09:00:00 + #1999-01-25T09:00:00 + #1999-01-26T09:00:00 + #1999-01-27T09:00:00 + #1999-01-28T09:00:00 + #1999-01-29T09:00:00 + #1999-01-30T09:00:00 + #1999-01-31T09:00:00 + #2000-01-01T09:00:00 + #2000-01-02T09:00:00 + #2000-01-03T09:00:00 + #2000-01-04T09:00:00 + #2000-01-05T09:00:00 + #2000-01-06T09:00:00 + #2000-01-07T09:00:00 + #2000-01-08T09:00:00 + #2000-01-09T09:00:00 + #2000-01-10T09:00:00 + #2000-01-11T09:00:00 + #2000-01-12T09:00:00 + #2000-01-13T09:00:00 + #2000-01-14T09:00:00 + #2000-01-15T09:00:00 + #2000-01-16T09:00:00 + #2000-01-17T09:00:00 + #2000-01-18T09:00:00 + #2000-01-19T09:00:00 + #2000-01-20T09:00:00 + #2000-01-21T09:00:00 + #2000-01-22T09:00:00 + #2000-01-23T09:00:00 + #2000-01-24T09:00:00 + #2000-01-25T09:00:00 + #2000-01-26T09:00:00 + #2000-01-27T09:00:00 + #2000-01-28T09:00:00 + #2000-01-29T09:00:00 + #2000-01-30T09:00:00 + #2000-01-31T09:00:00)) + (vevent + summary: + "Weekly for 10 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=WEEKLY;COUNT=10" + x-summary: + "varje vecka, totalt 10 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-09T09:00:00 + #1997-09-16T09:00:00 + #1997-09-23T09:00:00 + #1997-09-30T09:00:00 + #1997-10-07T09:00:00 + #1997-10-14T09:00:00 + #1997-10-21T09:00:00 + #1997-10-28T09:00:00 + #1997-11-04T09:00:00)) + (vevent + summary: + "Weekly until December 24, 1997" + dtstart: + "19970902T090000" + rrule: + "FREQ=WEEKLY;UNTIL=19971224T000000Z" + x-summary: + "varje vecka, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-09T09:00:00 + #1997-09-16T09:00:00 + #1997-09-23T09:00:00 + #1997-09-30T09:00:00 + #1997-10-07T09:00:00 + #1997-10-14T09:00:00 + #1997-10-21T09:00:00 + #1997-10-28T09:00:00 + #1997-11-04T09:00:00 + #1997-11-11T09:00:00 + #1997-11-18T09:00:00 + #1997-11-25T09:00:00 + #1997-12-02T09:00:00 + #1997-12-09T09:00:00 + #1997-12-16T09:00:00 + #1997-12-23T09:00:00)) + (vevent + summary: + "Every other week - forever" + dtstart: + "19970902T090000" + rrule: + "FREQ=WEEKLY;INTERVAL=2;WKST=SU" + x-summary: + "varannan vecka" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-16T09:00:00 + #1997-09-30T09:00:00 + #1997-10-14T09:00:00 + #1997-10-28T09:00:00 + #1997-11-11T09:00:00 + #1997-11-25T09:00:00 + #1997-12-09T09:00:00 + #1997-12-23T09:00:00 + #1998-01-06T09:00:00 + #1998-01-20T09:00:00 + #1998-02-03T09:00:00 + #1998-02-17T09:00:00 + #1998-03-03T09:00:00 + #1998-03-17T09:00:00 + #1998-03-31T09:00:00 + #1998-04-14T09:00:00 + #1998-04-28T09:00:00 + #1998-05-12T09:00:00 + #1998-05-26T09:00:00)) + (vevent + summary: + "Weekly on Tuesday and Thursday for five weeks (alt 1)" + dtstart: + "19970902T090000" + rrule: + "FREQ=WEEKLY;UNTIL=19971007T000000Z;WKST=SU;BYDAY=TU,TH" + x-summary: + "varje tisdag & torsdag, till och med den 07 oktober, 1997 kl. 0:00" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-04T09:00:00 + #1997-09-09T09:00:00 + #1997-09-11T09:00:00 + #1997-09-16T09:00:00 + #1997-09-18T09:00:00 + #1997-09-23T09:00:00 + #1997-09-25T09:00:00 + #1997-09-30T09:00:00 + #1997-10-02T09:00:00)) + (vevent + summary: + "Weekly on Tuesday and Thursday for five weeks (alt 2)" + dtstart: + "19970902T090000" + rrule: + "FREQ=WEEKLY;COUNT=10;WKST=SU;BYDAY=TU,TH" + x-summary: + "varje tisdag & torsdag, totalt 10 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-04T09:00:00 + #1997-09-09T09:00:00 + #1997-09-11T09:00:00 + #1997-09-16T09:00:00 + #1997-09-18T09:00:00 + #1997-09-23T09:00:00 + #1997-09-25T09:00:00 + #1997-09-30T09:00:00 + #1997-10-02T09:00:00)) + (vevent + summary: + "Every other week on Monday, Wednesday, and Friday until December 24, 1997, starting on Monday, September 1, 1997:" + dtstart: + "19970901T090000" + rrule: + "FREQ=WEEKLY;INTERVAL=2;UNTIL=19971224T000000Z;WKST=SU;BYDAY=MO,WE,FR" + x-summary: + "varannan måndag, onsdag & fredag, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list #1997-09-01T09:00:00 + #1997-09-03T09:00:00 + #1997-09-05T09:00:00 + #1997-09-15T09:00:00 + #1997-09-17T09:00:00 + #1997-09-19T09:00:00 + #1997-09-29T09:00:00 + #1997-10-01T09:00:00 + #1997-10-03T09:00:00 + #1997-10-13T09:00:00 + #1997-10-15T09:00:00 + #1997-10-17T09:00:00 + #1997-10-27T09:00:00 + #1997-10-29T09:00:00 + #1997-10-31T09:00:00 + #1997-11-10T09:00:00 + #1997-11-12T09:00:00 + #1997-11-14T09:00:00 + #1997-11-24T09:00:00 + #1997-11-26T09:00:00 + #1997-11-28T09:00:00 + #1997-12-08T09:00:00 + #1997-12-10T09:00:00 + #1997-12-12T09:00:00 + #1997-12-22T09:00:00)) + (vevent + summary: + "Every other week on Tuesday and Thursday, for 8 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=WEEKLY;INTERVAL=2;COUNT=8;WKST=SU;BYDAY=TU,TH" + x-summary: + "varannan tisdag & torsdag, totalt 8 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-04T09:00:00 + #1997-09-16T09:00:00 + #1997-09-18T09:00:00 + #1997-09-30T09:00:00 + #1997-10-02T09:00:00 + #1997-10-14T09:00:00 + #1997-10-16T09:00:00)) + (vevent + summary: + "Monthly on the first Friday for 10 occurrences" + dtstart: + "19970905T090000" + rrule: + "FREQ=MONTHLY;COUNT=10;BYDAY=1FR" + x-summary: + "första fredagen varje månad, totalt 10 gånger" + x-set: + (list #1997-09-05T09:00:00 + #1997-10-03T09:00:00 + #1997-11-07T09:00:00 + #1997-12-05T09:00:00 + #1998-01-02T09:00:00 + #1998-02-06T09:00:00 + #1998-03-06T09:00:00 + #1998-04-03T09:00:00 + #1998-05-01T09:00:00 + #1998-06-05T09:00:00)) + (vevent + summary: + "Monthly on the first Friday until December 24, 1997" + dtstart: + "19970905T090000" + rrule: + "FREQ=MONTHLY;UNTIL=19971224T000000Z;BYDAY=1FR" + x-summary: + "första fredagen varje månad, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list #1997-09-05T09:00:00 + #1997-10-03T09:00:00 + #1997-11-07T09:00:00 + #1997-12-05T09:00:00)) + (vevent + summary: + "Every other month on the first and last Sunday of the month for 10 occurrences" + dtstart: + "19970907T090000" + rrule: + "FREQ=MONTHLY;INTERVAL=2;COUNT=10;BYDAY=1SU,-1SU" + x-summary: + "första söndagen samt sista söndagen varannan månad, totalt 10 gånger" + x-set: + (list #1997-09-07T09:00:00 + #1997-09-28T09:00:00 + #1997-11-02T09:00:00 + #1997-11-30T09:00:00 + #1998-01-04T09:00:00 + #1998-01-25T09:00:00 + #1998-03-01T09:00:00 + #1998-03-29T09:00:00 + #1998-05-03T09:00:00 + #1998-05-31T09:00:00)) + (vevent + summary: + "Monthly on the second-to-last Monday of the month for 6 months" + dtstart: + "19970922T090000" + rrule: + "FREQ=MONTHLY;COUNT=6;BYDAY=-2MO" + x-summary: + "näst sista måndagen varje månad, totalt 6 gånger" + x-set: + (list #1997-09-22T09:00:00 + #1997-10-20T09:00:00 + #1997-11-17T09:00:00 + #1997-12-22T09:00:00 + #1998-01-19T09:00:00 + #1998-02-16T09:00:00)) + (vevent + summary: + "Monthly on the third-to-the-last day of the month, forever" + dtstart: + "19970928T090000" + rrule: + "FREQ=MONTHLY;BYMONTHDAY=-3" + x-summary: + "den tredje sista varje månad" + x-set: + (list #1997-09-28T09:00:00 + #1997-10-29T09:00:00 + #1997-11-28T09:00:00 + #1997-12-29T09:00:00 + #1998-01-29T09:00:00 + #1998-02-26T09:00:00 + #1998-03-29T09:00:00 + #1998-04-28T09:00:00 + #1998-05-29T09:00:00 + #1998-06-28T09:00:00 + #1998-07-29T09:00:00 + #1998-08-29T09:00:00 + #1998-09-28T09:00:00 + #1998-10-29T09:00:00 + #1998-11-28T09:00:00 + #1998-12-29T09:00:00 + #1999-01-29T09:00:00 + #1999-02-26T09:00:00 + #1999-03-29T09:00:00 + #1999-04-28T09:00:00)) + (vevent + summary: + "Monthly on the 2nd and 15th of the month for 10 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=MONTHLY;COUNT=10;BYMONTHDAY=2,15" + x-summary: + "den andre & femtonde varje månad, totalt 10 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-15T09:00:00 + #1997-10-02T09:00:00 + #1997-10-15T09:00:00 + #1997-11-02T09:00:00 + #1997-11-15T09:00:00 + #1997-12-02T09:00:00 + #1997-12-15T09:00:00 + #1998-01-02T09:00:00 + #1998-01-15T09:00:00)) + (vevent + summary: + "Monthly on the first and last day of the month for 10 occurrences" + dtstart: + "19970930T090000" + rrule: + "FREQ=MONTHLY;COUNT=10;BYMONTHDAY=1,-1" + x-summary: + "den förste & sista varje månad, totalt 10 gånger" + x-set: + (list #1997-09-30T09:00:00 + #1997-10-01T09:00:00 + #1997-10-31T09:00:00 + #1997-11-01T09:00:00 + #1997-11-30T09:00:00 + #1997-12-01T09:00:00 + #1997-12-31T09:00:00 + #1998-01-01T09:00:00 + #1998-01-31T09:00:00 + #1998-03-01T09:00:00)) + (vevent + summary: + "Every 18 months on the 10th thru 15th of the month for 10 occurrences" + dtstart: + "19970910T090000" + rrule: + "FREQ=MONTHLY;INTERVAL=18;COUNT=10;BYMONTHDAY=10,11,12,13,14,15" + x-summary: + "den tionde, elfte, tolfte, trettonde, fjortonde & femtonde var artonde månad, totalt 10 gånger" + x-set: + (list #1997-09-10T09:00:00 + #1997-09-11T09:00:00 + #1997-09-12T09:00:00 + #1997-09-13T09:00:00 + #1997-09-14T09:00:00 + #1997-09-15T09:00:00 + #1999-03-10T09:00:00 + #1999-03-11T09:00:00 + #1999-03-12T09:00:00 + #1999-03-13T09:00:00)) + (vevent + summary: + "Every Tuesday, every other month" + dtstart: + "19970902T090000" + rrule: + "FREQ=MONTHLY;INTERVAL=2;BYDAY=TU" + x-summary: + "varje tisdag varannan månad" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-09T09:00:00 + #1997-09-16T09:00:00 + #1997-09-23T09:00:00 + #1997-09-30T09:00:00 + #1997-11-04T09:00:00 + #1997-11-11T09:00:00 + #1997-11-18T09:00:00 + #1997-11-25T09:00:00 + #1998-01-06T09:00:00 + #1998-01-13T09:00:00 + #1998-01-20T09:00:00 + #1998-01-27T09:00:00 + #1998-03-03T09:00:00 + #1998-03-10T09:00:00 + #1998-03-17T09:00:00 + #1998-03-24T09:00:00 + #1998-03-31T09:00:00 + #1998-05-05T09:00:00 + #1998-05-12T09:00:00)) + (vevent + summary: + "Yearly in June and July for 10 occurrences:\n: Since none of the BYDAY, BYMONTHDAY, or BYYEARDAY\nonents are specified, the day is gotten from \"DTSTART\"" + dtstart: + "19970610T090000" + rrule: + "FREQ=YEARLY;COUNT=10;BYMONTH=6,7" + x-summary: + "juni & juli, årligen, totalt 10 gånger" + x-set: + (list #1997-06-10T09:00:00 + #1997-07-10T09:00:00 + #1998-06-10T09:00:00 + #1998-07-10T09:00:00 + #1999-06-10T09:00:00 + #1999-07-10T09:00:00 + #2000-06-10T09:00:00 + #2000-07-10T09:00:00 + #2001-06-10T09:00:00 + #2001-07-10T09:00:00)) + (vevent + summary: + "Every other year on January, February, and March for 10 occurrences" + dtstart: + "19970310T090000" + rrule: + "FREQ=YEARLY;INTERVAL=2;COUNT=10;BYMONTH=1,2,3" + x-summary: + "januari, februari & mars vartannat år, totalt 10 gånger" + x-set: + (list #1997-03-10T09:00:00 + #1999-01-10T09:00:00 + #1999-02-10T09:00:00 + #1999-03-10T09:00:00 + #2001-01-10T09:00:00 + #2001-02-10T09:00:00 + #2001-03-10T09:00:00 + #2003-01-10T09:00:00 + #2003-02-10T09:00:00 + #2003-03-10T09:00:00)) + (vevent + summary: + "Every third year on the 1st, 100th, and 200th day for 10 occurrences" + dtstart: + "19970101T090000" + rrule: + "FREQ=YEARLY;INTERVAL=3;COUNT=10;BYYEARDAY=1,100,200" + x-summary: + "dag 1, 100 & 200 vart tredje år, totalt 10 gånger" + x-set: + (list #1997-01-01T09:00:00 + #1997-04-10T09:00:00 + #1997-07-19T09:00:00 + #2000-01-01T09:00:00 + #2000-04-09T09:00:00 + #2000-07-18T09:00:00 + #2003-01-01T09:00:00 + #2003-04-10T09:00:00 + #2003-07-19T09:00:00 + #2006-01-01T09:00:00)) + (vevent + summary: + "Every 20th Monday of the year, forever" + dtstart: + "19970519T090000" + rrule: + "FREQ=YEARLY;BYDAY=20MO" + x-summary: + "tjugonde måndagen, årligen" + x-set: + (list #1997-05-19T09:00:00 + #1998-05-18T09:00:00 + #1999-05-17T09:00:00 + #2000-05-15T09:00:00 + #2001-05-14T09:00:00 + #2002-05-20T09:00:00 + #2003-05-19T09:00:00 + #2004-05-17T09:00:00 + #2005-05-16T09:00:00 + #2006-05-15T09:00:00 + #2007-05-14T09:00:00 + #2008-05-19T09:00:00 + #2009-05-18T09:00:00 + #2010-05-17T09:00:00 + #2011-05-16T09:00:00 + #2012-05-14T09:00:00 + #2013-05-20T09:00:00 + #2014-05-19T09:00:00 + #2015-05-18T09:00:00 + #2016-05-16T09:00:00)) + (vevent + summary: + "Monday of week number 20 (where the default start of the week is Monday), forever" + dtstart: + "19970512T090000" + rrule: + "FREQ=YEARLY;BYWEEKNO=20;BYDAY=MO" + x-summary: + "varje måndag v.20, årligen" + x-set: + (list #1997-05-12T09:00:00 + #1998-05-11T09:00:00 + #1999-05-17T09:00:00 + #2000-05-15T09:00:00 + #2001-05-14T09:00:00 + #2002-05-13T09:00:00 + #2003-05-12T09:00:00 + #2004-05-10T09:00:00 + #2005-05-16T09:00:00 + #2006-05-15T09:00:00 + #2007-05-14T09:00:00 + #2008-05-12T09:00:00 + #2009-05-11T09:00:00 + #2010-05-17T09:00:00 + #2011-05-16T09:00:00 + #2012-05-14T09:00:00 + #2013-05-13T09:00:00 + #2014-05-12T09:00:00 + #2015-05-11T09:00:00 + #2016-05-16T09:00:00)) + (vevent + summary: + "Every Thursday in March, forever" + dtstart: + "19970313T090000" + rrule: + "FREQ=YEARLY;BYMONTH=3;BYDAY=TH" + x-summary: + "varje torsdag i mars, årligen" + x-set: + (list #1997-03-13T09:00:00 + #1997-03-20T09:00:00 + #1997-03-27T09:00:00 + #1998-03-05T09:00:00 + #1998-03-12T09:00:00 + #1998-03-19T09:00:00 + #1998-03-26T09:00:00 + #1999-03-04T09:00:00 + #1999-03-11T09:00:00 + #1999-03-18T09:00:00 + #1999-03-25T09:00:00 + #2000-03-02T09:00:00 + #2000-03-09T09:00:00 + #2000-03-16T09:00:00 + #2000-03-23T09:00:00 + #2000-03-30T09:00:00 + #2001-03-01T09:00:00 + #2001-03-08T09:00:00 + #2001-03-15T09:00:00 + #2001-03-22T09:00:00)) + (vevent + summary: + "Every Thursday, but only during June, July, and August, forever" + dtstart: + "19970605T090000" + rrule: + "FREQ=YEARLY;BYDAY=TH;BYMONTH=6,7,8" + x-summary: + "varje torsdag i juni, juli & augusti, årligen" + x-set: + (list #1997-06-05T09:00:00 + #1997-06-12T09:00:00 + #1997-06-19T09:00:00 + #1997-06-26T09:00:00 + #1997-07-03T09:00:00 + #1997-07-10T09:00:00 + #1997-07-17T09:00:00 + #1997-07-24T09:00:00 + #1997-07-31T09:00:00 + #1997-08-07T09:00:00 + #1997-08-14T09:00:00 + #1997-08-21T09:00:00 + #1997-08-28T09:00:00 + #1998-06-04T09:00:00 + #1998-06-11T09:00:00 + #1998-06-18T09:00:00 + #1998-06-25T09:00:00 + #1998-07-02T09:00:00 + #1998-07-09T09:00:00 + #1998-07-16T09:00:00)) + (vevent + summary: + "Every Friday the 13th, forever" + dtstart: + "19970902T090000" + exdate: + "19970902T090000" + rrule: + "FREQ=MONTHLY;BYDAY=FR;BYMONTHDAY=13" + x-summary: + "varje fredag den trettonde varje månad" + x-set: + (list #1998-02-13T09:00:00 + #1998-03-13T09:00:00 + #1998-11-13T09:00:00 + #1999-08-13T09:00:00 + #2000-10-13T09:00:00 + #2001-04-13T09:00:00 + #2001-07-13T09:00:00 + #2002-09-13T09:00:00 + #2002-12-13T09:00:00 + #2003-06-13T09:00:00 + #2004-02-13T09:00:00 + #2004-08-13T09:00:00 + #2005-05-13T09:00:00 + #2006-01-13T09:00:00 + #2006-10-13T09:00:00 + #2007-04-13T09:00:00 + #2007-07-13T09:00:00 + #2008-06-13T09:00:00 + #2009-02-13T09:00:00 + #2009-03-13T09:00:00)) + (vevent + summary: + "The first Saturday that follows the first Sunday of the month, forever" + dtstart: + "19970913T090000" + rrule: + "FREQ=MONTHLY;BYDAY=SA;BYMONTHDAY=7,8,9,10,11,12,13" + x-summary: + "varje lördag den sjunde, åttonde, nionde, tionde, elfte, tolfte & trettonde varje månad" + x-set: + (list #1997-09-13T09:00:00 + #1997-10-11T09:00:00 + #1997-11-08T09:00:00 + #1997-12-13T09:00:00 + #1998-01-10T09:00:00 + #1998-02-07T09:00:00 + #1998-03-07T09:00:00 + #1998-04-11T09:00:00 + #1998-05-09T09:00:00 + #1998-06-13T09:00:00 + #1998-07-11T09:00:00 + #1998-08-08T09:00:00 + #1998-09-12T09:00:00 + #1998-10-10T09:00:00 + #1998-11-07T09:00:00 + #1998-12-12T09:00:00 + #1999-01-09T09:00:00 + #1999-02-13T09:00:00 + #1999-03-13T09:00:00 + #1999-04-10T09:00:00)) + (vevent + summary: + "Every 4 years, the first Tuesday after a Monday in November,\nver (U.S. Presidential Election day)" + dtstart: + "19961105T090000" + rrule: + "FREQ=YEARLY;INTERVAL=4;BYMONTH=11;BYDAY=TU;BYMONTHDAY=2,3,4,5,6,7,8" + x-summary: + "varje tisdag den andre, tredje, fjärde, femte, sjätte, sjunde eller åttonde i november vart fjärde år" + x-set: + (list #1996-11-05T09:00:00 + #2000-11-07T09:00:00 + #2004-11-02T09:00:00 + #2008-11-04T09:00:00 + #2012-11-06T09:00:00 + #2016-11-08T09:00:00 + #2020-11-03T09:00:00 + #2024-11-05T09:00:00 + #2028-11-07T09:00:00 + #2032-11-02T09:00:00 + #2036-11-04T09:00:00 + #2040-11-06T09:00:00 + #2044-11-08T09:00:00 + #2048-11-03T09:00:00 + #2052-11-05T09:00:00 + #2056-11-07T09:00:00 + #2060-11-02T09:00:00 + #2064-11-04T09:00:00 + #2068-11-06T09:00:00 + #2072-11-08T09:00:00)) + (vevent + summary: + "The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months" + dtstart: + "19970904T090000" + rrule: + "FREQ=MONTHLY;COUNT=3;BYDAY=TU,WE,TH;BYSETPOS=3" + x-summary: + "NOT YET IMPLEMENTED" + x-set: + (list #1997-09-04T09:00:00 + #1997-10-07T09:00:00 + #1997-11-06T09:00:00)) + (vevent + summary: + "The second-to-last weekday of the month" + dtstart: + "19970929T090000" + rrule: + "FREQ=MONTHLY;BYDAY=MO,TU,WE,TH,FR;BYSETPOS=-2" + x-summary: + "NOT YET IMPLEMENTED" + x-set: + (list #1997-09-29T09:00:00 + #1997-10-30T09:00:00 + #1997-11-27T09:00:00 + #1997-12-30T09:00:00 + #1998-01-29T09:00:00)) + (vevent + summary: + "Every 3 hours from 9:00 AM to 5:00 PM on a specific day" + dtstart: + "19970902T090000" + rrule: + "FREQ=HOURLY;INTERVAL=3;UNTIL=19970902T170000Z" + x-summary: + "var tredje timme, till och med den 02 september, 1997 kl. 17:00" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-02T12:00:00 + #1997-09-02T15:00:00)) + (vevent + summary: + "Every 15 minutes for 6 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=MINUTELY;INTERVAL=15;COUNT=6" + x-summary: + "varje kvart, totalt 6 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-02T09:15:00 + #1997-09-02T09:30:00 + #1997-09-02T09:45:00 + #1997-09-02T10:00:00 + #1997-09-02T10:15:00)) + (vevent + summary: + "Every hour and a half for 4 occurrences" + dtstart: + "19970902T090000" + rrule: + "FREQ=MINUTELY;INTERVAL=90;COUNT=4" + x-summary: + "var sjätte kvart, totalt 4 gånger" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-02T10:30:00 + #1997-09-02T12:00:00 + #1997-09-02T13:30:00)) + (vevent + summary: + "Every 20 minutes from 9:00 AM to 4:40 PM every day (alt 1)" + dtstart: + "19970902T090000" + rrule: + "FREQ=DAILY;BYHOUR=9,10,11,12,13,14,15,16;BYMINUTE=0,20,40" + x-summary: + "dagligen kl. 09:00, 09:20, 09:40, 10:00, 10:20, 10:40, 11:00, 11:20, 11:40, 12:00, 12:20, 12:40, 13:00, 13:20, 13:40, 14:00, 14:20, 14:40, 15:00, 15:20, 15:40, 16:00, 16:20 & 16:40" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-02T09:20:00 + #1997-09-02T09:40:00 + #1997-09-02T10:00:00 + #1997-09-02T10:20:00 + #1997-09-02T10:40:00 + #1997-09-02T11:00:00 + #1997-09-02T11:20:00 + #1997-09-02T11:40:00 + #1997-09-02T12:00:00 + #1997-09-02T12:20:00 + #1997-09-02T12:40:00 + #1997-09-02T13:00:00 + #1997-09-02T13:20:00 + #1997-09-02T13:40:00 + #1997-09-02T14:00:00 + #1997-09-02T14:20:00 + #1997-09-02T14:40:00 + #1997-09-02T15:00:00 + #1997-09-02T15:20:00)) + (vevent + summary: + "Every 20 minutes from 9:00 AM to 4:40 PM every day (alt 2)" + dtstart: + "19970902T090000" + rrule: + "FREQ=MINUTELY;INTERVAL=20;BYHOUR=9,10,11,12,13,14,15,16" + x-summary: + "var tjugonde minut kl. 9, 10, 11, 12, 13, 14, 15 & 16" + x-set: + (list #1997-09-02T09:00:00 + #1997-09-02T09:20:00 + #1997-09-02T09:40:00 + #1997-09-02T10:00:00 + #1997-09-02T10:20:00 + #1997-09-02T10:40:00 + #1997-09-02T11:00:00 + #1997-09-02T11:20:00 + #1997-09-02T11:40:00 + #1997-09-02T12:00:00 + #1997-09-02T12:20:00 + #1997-09-02T12:40:00 + #1997-09-02T13:00:00 + #1997-09-02T13:20:00 + #1997-09-02T13:40:00 + #1997-09-02T14:00:00 + #1997-09-02T14:20:00 + #1997-09-02T14:40:00 + #1997-09-02T15:00:00 + #1997-09-02T15:20:00)) + (vevent + summary: + "An example where the days generated makes a difference because of WKST" + dtstart: + "19970805T090000" + rrule: + "FREQ=WEEKLY;INTERVAL=2;COUNT=4;BYDAY=TU,SU;WKST=MO" + x-summary: + "varannan tisdag & söndag, totalt 4 gånger" + x-set: + (list #1997-08-05T09:00:00 + #1997-08-10T09:00:00 + #1997-08-19T09:00:00 + #1997-08-24T09:00:00)) + (vevent + summary: + "changing only WKST from MO to SU, yields different results.." + dtstart: + "19970805T090000" + rrule: + "FREQ=WEEKLY;INTERVAL=2;COUNT=4;BYDAY=TU,SU;WKST=SU" + x-summary: + "varannan tisdag & söndag, totalt 4 gånger" + x-set: + (list #1997-08-05T09:00:00 + #1997-08-17T09:00:00 + #1997-08-19T09:00:00 + #1997-08-31T09:00:00)) + (vevent + summary: + "An example where an invalid date (i.e., February 30) is ignored" + dtstart: + "20070115T090000" + rrule: + "FREQ=MONTHLY;BYMONTHDAY=15,30;COUNT=5" + x-summary: + "den femtonde & tretionde varje månad, totalt 5 gånger" + x-set: + (list #2007-01-15T09:00:00 + #2007-01-30T09:00:00 + #2007-02-15T09:00:00 + #2007-03-15T09:00:00 + #2007-03-30T09:00:00)) + (vevent + summary: + "Every Friday & Wednesday the 13th, forever" + dtstart: + "19970902T090000" + exdate: + "19970902T090000" + rrule: + "FREQ=MONTHLY;BYDAY=FR,WE;BYMONTHDAY=13" + x-summary: + "varje onsdag & fredag den trettonde varje månad" + x-set: + (list #1998-02-13T09:00:00 + #1998-03-13T09:00:00 + #1998-05-13T09:00:00 + #1998-11-13T09:00:00 + #1999-01-13T09:00:00 + #1999-08-13T09:00:00 + #1999-10-13T09:00:00 + #2000-09-13T09:00:00 + #2000-10-13T09:00:00 + #2000-12-13T09:00:00 + #2001-04-13T09:00:00 + #2001-06-13T09:00:00 + #2001-07-13T09:00:00 + #2002-02-13T09:00:00 + #2002-03-13T09:00:00 + #2002-09-13T09:00:00 + #2002-11-13T09:00:00 + #2002-12-13T09:00:00 + #2003-06-13T09:00:00 + #2003-08-13T09:00:00)) + (vevent + summary: + "Monday & Wednesday of week number 20 (where the default start of the week is Monday), forever" + dtstart: + "19970512T090000" + rrule: + "FREQ=YEARLY;BYWEEKNO=20;BYDAY=MO,WE" + x-summary: + "varje onsdag & måndag v.20, årligen" + x-set: + (list #1997-05-12T09:00:00 + #1997-05-14T09:00:00 + #1998-05-11T09:00:00 + #1998-05-13T09:00:00 + #1999-05-17T09:00:00 + #1999-05-19T09:00:00 + #2000-05-15T09:00:00 + #2000-05-17T09:00:00 + #2001-05-14T09:00:00 + #2001-05-16T09:00:00 + #2002-05-13T09:00:00 + #2002-05-15T09:00:00 + #2003-05-12T09:00:00 + #2003-05-14T09:00:00 + #2004-05-10T09:00:00 + #2004-05-12T09:00:00 + #2005-05-16T09:00:00 + #2005-05-18T09:00:00 + #2006-05-15T09:00:00 + #2006-05-17T09:00:00)))) + + diff --git a/tests/test/recurrence-simple.scm b/tests/test/recurrence-simple.scm new file mode 100644 index 00000000..0f421b05 --- /dev/null +++ b/tests/test/recurrence-simple.scm @@ -0,0 +1,296 @@ +;;; Commentary: +;; Simples tests of recurrence system, ensuring that all parsers and +;; basic generators work. Some more fully-featured tests are here, but +;; most are instead in recurrence-advanced.scm. +;;; Code: + +(define-module (test recurrence-simple) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((srfi srfi-41) + :select (stream-take stream-map stream->list stream-car)) + :use-module ((datetime) :select (day-stream mon)) + :use-module ((vcomponent base) :select (extract prop)) + :use-module ((hnh util exceptions) + :select (warnings-are-errors warning-handler)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((vcomponent formats xcal parse) + :select (sxcal->vcomponent)) + :use-module ((vcomponent recurrence) + :select (parse-recurrence-rule + make-recur-rule + generate-recurrence-set))) + +;;; Test that basic parsing or recurrence rules work. + +(test-equal (make-recur-rule freq: 'HOURLY wkst: mon interval: 1) + (parse-recurrence-rule "FREQ=HOURLY")) + +(test-equal (make-recur-rule freq: 'HOURLY count: 3 interval: 1 wkst: mon) + (parse-recurrence-rule "FREQ=HOURLY;COUNT=3")) + +;;; Test that recurrence rule parsing fails where appropriate + +(parameterize ((warnings-are-errors #t) + (warning-handler identity)) + (test-error "Invalid FREQ" + 'warning + (parse-recurrence-rule "FREQ=ERR;COUNT=3")) + (test-error "Negative COUNT" + 'warning + (parse-recurrence-rule "FREQ=HOURLY;COUNT=-1")) + (test-error "Invalid COUNT" + 'wrong-type-argument + (parse-recurrence-rule "FREQ=HOURLY;COUNT=err"))) + +;;; Test that basic recurrence works +;;; also see the neighbour test file recurrence.scm for more tests. + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;VALUE=DATE:20190302 +RRULE:FREQ=DAILY +END:VEVENT" + parse-calendar)) + +(test-assert "Generate at all" + (stream-car (generate-recurrence-set ev))) + +(test-assert "Generate some" + (stream->list + (stream-take 5 (generate-recurrence-set ev)))) + +(test-equal "Generate First" + (stream->list + 5 + (stream-map + (extract 'DTSTART) + (generate-recurrence-set ev))) + (stream->list 5 (day-stream (prop ev 'DTSTART)))) + +;; We run the exact same thing a secound time, since I had an error with +;; that during development. + +(test-equal "Generate Again" + (stream->list + (stream-take + 5 + (stream-map + (extract 'DTSTART) + (generate-recurrence-set ev)))) + (stream->list + (stream-take 5 (day-stream (prop ev 'DTSTART))))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +RRULE:FREQ=DAILY +END:VEVENT" + parse-calendar)) + +(test-assert "daily 10:00" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +DTEND:20190302T120000 +RRULE:FREQ=DAILY +END:VEVENT" + parse-calendar)) + +(test-assert "daily 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +DTEND:20190302T120000 +RRULE:FREQ=WEEKLY +END:VEVENT" + parse-calendar)) + +(test-assert "weekly 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20190302T100000 +DTEND;TZID=Europe/Stockholm:20190302T120000 +RRULE:FREQ=WEEKLY +END:VEVENT" + parse-calendar)) + +(test-assert "weekly TZ 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20190302T100000 +DTEND;TZID=Europe/Stockholm:20190302T120000 +RRULE:FREQ=WEEKLY +SEQUENCE:1 +END:VEVENT" + parse-calendar)) + +(test-assert "weekly TZ SEQUENCE 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20190302T100000 +RRULE:FREQ=WEEKLY +DTEND;TZID=Europe/Stockholm:20190302T120000 +SEQUENCE:1 +LOCATION:Here +END:VEVENT" + parse-calendar)) + +(test-assert "weekly TZ SEQUENCE LOCATION 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20180117T170000 +RRULE:FREQ=WEEKLY +LOCATION:~ +END:VEVENT" + parse-calendar)) + +(test-assert "Just location" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20180117T170000 +DTEND;TZID=Europe/Stockholm:20180117T200000 +RRULE:FREQ=WEEKLY +END:VEVENT" + parse-calendar)) + +(test-assert "Same times" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20180117T170000 +RRULE:FREQ=WEEKLY +DTEND;TZID=Europe/Stockholm:20180117T200000 +SEQUENCE:1 +LOCATION:~ +END:VEVENT" + parse-calendar)) + +;; errer in dtend ? + +(test-assert "Full test" + (stream-car (generate-recurrence-set ev))) + +;;; Tests that exceptions (in the recurrence-id meaning) +;;; in recurrence sets are handled correctly. +;;; TODO Is however far from done. + +(define uid (symbol->string (gensym "areallyuniqueid"))) + +;; TODO standardize vcomponents for tests as xcal, for example: +`(vcalendar + (children + (vevent + (properties + (summary + (text "Changing type on Recurrence-id.")) + (uid (text ,uid)) + (dtstart (date "20090127")))) + (vevent + (properties + (summary + (text "Changing type on Recurrence-id.")) + (uid (text ,uid)) + (dtstart + (params (TZID "Europe/Stockholm")) + (date-time "20100127T120000")) + (recurrence-id (date "20100127")) + (summary + "This instance only has a time component"))))) + +(define ev + (call-with-input-string + (format + #f + "BEGIN:VCALENDAR +BEGIN:VEVENT +SUMMARY:Changing type on Recurrence-id. +UID:~a +DTSTART;VALUE=DATE:20090127 +END:VEVENT +BEGIN:VEVENT +UID:~a +SUMMARY:Changing type on Recurrence-id. +DTSTART;TZID=Europe/Stockholm:20100127T120000 +RECURRENCE-ID;VALUE=DATE:20100127 +SUMMARY:This instance only has a time component +END:VEVENT +END:VCALENDAR" + uid + uid) + parse-calendar)) + +(test-assert "Changing type on Recurrence id." + (stream->list 10 (generate-recurrence-set ev))) + +;;; Earlier I failed to actually parse the recurrence parts, in short, 1 ≠ "1". + +(test-assert "Test that xcal recur rules are parseable" + ((@@ (vcomponent formats xcal parse) handle-value) + 'recur + 'props-are-unused-for-recur + '((freq "WEEKLY") (interval "1") (wkst "MO")))) + +(define ev + (sxcal->vcomponent + '(vevent + (properties + (summary (text "reptest")) + (dtend (date-time "2021-01-13T02:00:00")) + (dtstart (date-time "2021-01-13T01:00:00")) + (uid (text "RNW198S6QANQPV1C4FDNFH6ER1VZX6KXEYNB")) + (rrule (recur (freq "WEEKLY") + (interval "1") + (wkst "MO"))) + (dtstamp (date-time "2021-01-13T01:42:20Z")) + (sequence (integer "0"))) + (components)))) + +(test-assert + "Check that recurrence rule commint from xcal also works" + (generate-recurrence-set ev)) + + +;;; TODO test here, for byday parsing, and multiple byday instances in one recur element +;;; TODO which should also test serializing and deserializing to xcal. +;;; For example, the following rules specify every workday + +;; BEGIN:VCALENDAR +;; PRODID:-//hugo//calp 0.6.1//EN +;; VERSION:2.0 +;; CALSCALE:GREGORIAN +;; BEGIN:VEVENT +;; SUMMARY:Lunch +;; DTSTART:20211129T133000 +;; DTEND:20211129T150000 +;; LAST-MODIFIED:20211204T220944Z +;; UID:3d82c73c-6cdb-4799-beba-5f1d20d55347 +;; RRULE:FREQ=DAILY;BYDAY=MO,TU,WE,TH,FR +;; END:VEVENT +;; END:VCALENDAR diff --git a/tests/test/rrule-serialization.scm b/tests/test/rrule-serialization.scm new file mode 100644 index 00000000..e616c5a2 --- /dev/null +++ b/tests/test/rrule-serialization.scm @@ -0,0 +1,75 @@ +(define-module (test rrule-serialization) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent recurrence internal) + :select (recur-rule->rrule-string + recur-rule->rrule-sxml + byday)) + :use-module ((vcomponent recurrence parse) + :select (parse-recurrence-rule)) + :use-module ((ice-9 peg) :select (keyword-flatten))) + +(test-equal + "Parse of week day" + '(#f . 3) + ((@@ (vcomponent recurrence parse) parse-day-spec) + "WE")) + +(test-equal + "Parse of week day with positive offset" + '(1 . 3) + ((@@ (vcomponent recurrence parse) parse-day-spec) + "1WE")) + +(test-equal + "Parse of week day with positive offset (and plus)" + '(2 . 3) + ((@@ (vcomponent recurrence parse) parse-day-spec) + "+2WE")) + +(test-equal + "Parse of week day with negative offset" + '(-3 . 3) + ((@@ (vcomponent recurrence parse) parse-day-spec) + "-3WE")) + + +;; numeric prefixes in the BYDAY list is only valid when +;; FREQ={MONTHLY,YEARLY}, but that should be handled in a +;; later stage since we are just testing the parser here. +;; (p. 41) + + +(define field->string + (@@ (vcomponent recurrence internal) + field->string)) + +(let ((rule (parse-recurrence-rule "BYDAY=MO,TU,WE"))) + (test-equal + "Direct return of parsed value" + "MO,TU,WE" + (field->string 'byday (byday rule))) + (test-equal + "Direct return, but as SXML" + '((byday "MO") (byday "TU") (byday "WE")) + (filter + (lambda (pair) (eq? 'byday (car pair))) + (keyword-flatten + '(interval byday wkst) + (recur-rule->rrule-sxml rule))))) + +(let ((rule (parse-recurrence-rule "BYDAY=+1MO,1TU,-2FR"))) + (test-equal + "Direct return of parsed value" + "1MO,1TU,-2FR" + (field->string 'byday (byday rule))) + (test-equal + "Direct return, but as SXML" + '((byday "1MO") (byday "1TU") (byday "-2FR")) + (filter + (lambda (pair) (eq? 'byday (car pair))) + (keyword-flatten + '(interval byday wkst) + (recur-rule->rrule-sxml rule))))) + + diff --git a/tests/test/server.scm b/tests/test/server.scm new file mode 100644 index 00000000..1b5d4775 --- /dev/null +++ b/tests/test/server.scm @@ -0,0 +1,24 @@ +;;; Commentary: +;; Tests parse-endpoint-string, used for defining server routes. +;;; Code: + +(define-module (test server) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((web http make-routes) + :select (parse-endpoint-string)) + :use-module ((hnh util) :select (let*))) + +(test-assert "Check that parsing doesn't crash" + (parse-endpoint-string "/static/:dir/:file")) + +;; Checks that parsing produces correct results +(let* ((path args (parse-endpoint-string "/static/:dir/:file"))) + (test-equal "/static/([^/.]+)/([^/.]+)" path) + (test-equal '(dir file) args)) + +;; Checks that parsing with custom regex works +;; along with literal periods. +(let* ((path args (parse-endpoint-string "/static/:filename{.*}.:ext"))) + (test-equal "/static/(.*)\\.([^/.]+)" path) + (test-equal '(filename ext) args)) diff --git a/tests/test/srfi-41-util.scm b/tests/test/srfi-41-util.scm new file mode 100644 index 00000000..176fb38e --- /dev/null +++ b/tests/test/srfi-41-util.scm @@ -0,0 +1,44 @@ +;;; Commentary: +;; Tests (srfi srfi-41 util). +;; Currently only tests stream-paginate. +;;; Code: + +(define-module (test srfi-41-util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((srfi srfi-41 util) :select (stream-paginate)) + :use-module ((srfi srfi-41) + :select (stream->list + stream-ref + stream-from + stream-filter + stream-car + stream)) + :use-module ((ice-9 sandbox) :select (call-with-time-limit))) + +(test-equal "Finite stream" + '((0 1 2) (3 4 5) (6 7 8) (9)) + (let ((strm (stream-paginate (stream 0 1 2 3 4 5 6 7 8 9) 3))) + (map stream->list (stream->list strm)))) + +(test-equal "slice of infinite" + '(1000 1001 1002 1003 1004 1005 1006 1007 1008 1009) + (let ((strm (stream-paginate (stream-from 0)))) + (stream->list (stream-ref strm 100)))) + +(define unique-symbol (gensym)) + +(test-equal "time out on infinite 'empty' stream" + unique-symbol + ;; defined outside time limit since creation should always + ;; succeed. Only reference is expected to fail. + (let ((strm (stream-paginate + ;; easy way to get stream which never finds + ;; any elements. + (stream-filter negative? (stream-from 0))))) + (call-with-time-limit + 0.1 + (lambda () (stream-car strm)) + (lambda _ unique-symbol)))) + + diff --git a/tests/test/termios.scm b/tests/test/termios.scm new file mode 100644 index 00000000..7f607cc4 --- /dev/null +++ b/tests/test/termios.scm @@ -0,0 +1,48 @@ +;;; Commentary: +;; Tests that my termios function works, at least somewhat. +;; Note that this actually modifies the terminal it's run on, and might fail +;; if the terminal doesn't support the wanted modes. See termios(3). +;; It might also leave the terminal in a broken state if exited prematurely. +;;; Code: + +(define-module (test termios) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((hnh util) :select (set!)) + :use-module ((vulgar termios) + :select (make-termios + copy-termios + lflag + tcgetattr! + tcsetattr! + ECHO + ICANON)) + :use-module ((srfi srfi-60) + :select ((bitwise-ior . ||) + (bitwise-not . ~) + (bitwise-and . &)))) + +(define tty (open-input-file "/dev/tty")) + +(define-syntax-rule (&= lvalue val) + (set! lvalue = ((lambda (v) (& v val))))) + +(define t (make-termios)) + +(test-equal 0 (tcgetattr! t tty)) + +(define ifl (lflag t)) + +(define copy (copy-termios t)) + +#!curly-infix {(lflag t) &= (~ (|| ECHO ICANON))} + +(test-equal 0 (tcsetattr! t tty)) + +(test-equal + (& ifl (~ (|| ECHO ICANON))) + (lflag t)) + +(test-equal 0 (tcsetattr! copy tty)) + + diff --git a/tests/test/tz.scm b/tests/test/tz.scm new file mode 100644 index 00000000..245258d0 --- /dev/null +++ b/tests/test/tz.scm @@ -0,0 +1,87 @@ +;;; 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) :select (let-env))) + +;; London alternates between +0000 and +0100 +(let-env + ((TZ "Europe/London")) + (test-equal + "London winter" + #2020-01-12T13:30:00 + (get-datetime + (parse-ics-datetime "20200112T133000Z"))) + (test-equal + "London summer" + #2020-06-12T14:30:00 + (get-datetime + (parse-ics-datetime "20200612T133000Z")))) + +;; Stockholm alternates between +0100 and +0200 +(let-env + ((TZ "Europe/Stockholm")) + (test-equal + "Stockholm winter" + #2020-01-12T14:30:00 + (get-datetime + (parse-ics-datetime "20200112T133000Z"))) + (test-equal + "Stockholm summer" + #2020-06-12T15:30: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: + #1970-01-01 + time: + #00:00:00 + tz: + "UTC") + (unix-time->datetime 0)) + + diff --git a/tests/test/util.scm b/tests/test/util.scm new file mode 100644 index 00000000..47edb225 --- /dev/null +++ b/tests/test/util.scm @@ -0,0 +1,145 @@ +;;; Commentary: +;; Checks some prodecuders from (hnh util) +;;; Code: + +(define-module (test util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((hnh util) + :select (filter-sorted + set/r! + find-min + find-max + find-extreme + span-upto + iterate + ->string + ->quoted-string + begin1)) + :use-module ((hnh util path) + :select (path-append path-split))) + +(test-equal + "Filter sorted" + '(3 4 5) + (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10))) + +(test-equal + "set/r! = single" + #f + (let ((x #t)) (set/r! x = not))) + +(test-error + 'syntax-error + (test-read-eval-string "(set/r! x err not)")) + +(call-with-values + (lambda () (find-min (iota 10))) + (lambda (extreme rest) + (test-equal "Found correct minimum" 0 extreme) + (test-equal + "Removed \"something\" from the set" + 9 + (length rest)))) + +(call-with-values + (lambda () + (find-max + '("Hello" "Test" "Something long") + string-length)) + (lambda (extreme rest) + (test-equal + "Found the longest string" + "Something long" + extreme) + (test-equal "Removed the string" 2 (length rest)) + (test-assert + "Other members left 1" + (member "Hello" rest)) + (test-assert + "Other members left 2" + (member "Test" rest)))) + +(test-error 'misc-error (find-extreme '())) + +(call-with-values + (lambda () + (span-upto + 2 + char-numeric? + (string->list "123456"))) + (lambda (head tail) + (test-equal '(#\1 #\2) head) + (test-equal '(#\3 #\4 #\5 #\6) tail))) + +(call-with-values + (lambda () + (span-upto + 2 + char-numeric? + (string->list "H123456"))) + (lambda (head tail) + (test-equal '() head) + (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail))) + +(let ((value #f)) + (test-equal + "begin1 return value" + "Hello" + (begin1 "Hello" (set! value "World"))) + (test-equal "begin1 side effects" "World" value)) + +(test-equal 0 (iterate 1- zero? 10)) + +(test-equal "5" (->string 5)) + +(test-equal "5" (->string "5")) + +(test-equal "5" (->quoted-string 5)) + +(test-equal "\"5\"" (->quoted-string "5")) + +(test-equal + "no slashes" + "home/user" + (path-append "home" "user")) + +(test-equal + "no slashes, absolute" + "/home/user" + (path-append "" "home" "user")) + +(test-equal + "slashes in one component, absolute" + "/home/user" + (path-append "" "/home/" "user")) + +(test-equal + "slashes in one component, absolute due to first" + "/home/user" + (path-append "/home/" "user")) + +(test-equal + "Slashes in both" + "home/user" + (path-append "home/" "/user")) + +(test-equal "root" "/" (path-append "")) + +(test-equal + '("usr" "lib" "test") + (path-split "usr/lib/test")) + +(test-equal + '("usr" "lib" "test") + (path-split "usr/lib/test/")) + +(test-equal + '("" "usr" "lib" "test") + (path-split "/usr/lib/test")) + +(test-equal + '("" "usr" "lib" "test") + (path-split "//usr////lib/test")) + + diff --git a/tests/test/vcomponent-control.scm b/tests/test/vcomponent-control.scm new file mode 100644 index 00000000..f408c8b4 --- /dev/null +++ b/tests/test/vcomponent-control.scm @@ -0,0 +1,36 @@ +;;; Commentary: +;; Tests that with-replaced-properties work. +;;; Code: + +(define-module (test vcomponent-control) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent util control) + :select (with-replaced-properties)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((vcomponent base) :select (prop))) + +(define ev + (call-with-input-string + "BEGIN:DUMMY\nX-KEY:value\nEND:DUMMY" + parse-calendar)) + +;; Test that temoraries are set and restored +(test-equal "value" (prop ev 'X-KEY)) + +(with-replaced-properties + (ev (X-KEY "other")) + (test-equal "other" (prop ev 'X-KEY))) + +(test-equal "value" (prop ev 'X-KEY)) + +;; Test that they are restored on non-local exit +(catch #t + (lambda () + (with-replaced-properties + (ev (X-KEY "other")) + (throw 'any))) + (lambda _ (test-equal "value" (prop ev 'X-KEY)))) + + diff --git a/tests/test/vcomponent-datetime.scm b/tests/test/vcomponent-datetime.scm new file mode 100644 index 00000000..073a70ae --- /dev/null +++ b/tests/test/vcomponent-datetime.scm @@ -0,0 +1,49 @@ +;;; Commentary: +;; Tests that event-clamping (checking how long part of an event +;; overlaps another time span) works. +;;; Code: + +(define-module (test vcomponent-datetime) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((datetime) :select (date time datetime)) + :use-module ((vcomponent datetime) :select (event-length/clamped)) + :use-module ((vcomponent formats ical parse) :select (parse-calendar))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20200329T170000 +DTEND:20200401T100000 +END:VEVENT" + parse-calendar)) + + +;; |-----------------| test interval +;; |----------| event interval + +(test-equal + "Correct clamping" + (datetime time: (time hour: 7)) ; 2020-03-29T17:00 - 2020-03-30T00:00 + (event-length/clamped + #2020-03-23 ; a time way before the start of the event + #2020-03-29 ; a time slightly after the end of the event + ev)) + +(define utc-ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20200329T150000Z +DTEND:20200401T080000Z +END:VEVENT" + parse-calendar)) + +(test-equal + "Correct clamping UTC" + (datetime time: (time hour: 7)) + (event-length/clamped + #2020-03-23 + #2020-03-29 + ev)) + + diff --git a/tests/test/vcomponent-formats-common-types.scm b/tests/test/vcomponent-formats-common-types.scm new file mode 100644 index 00000000..c8bfd323 --- /dev/null +++ b/tests/test/vcomponent-formats-common-types.scm @@ -0,0 +1,137 @@ +(define-module (test vcomponent-formats-common-types) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent formats common types) + :select (get-parser)) + :use-module ((datetime) :select (date time datetime))) + + + +(define parse-binary (get-parser 'BINARY)) +;; TODO + + + +(define parse-boolean (get-parser 'BOOLEAN)) + +(test-equal #t (parse-boolean #f "TRUE")) +(test-equal #f (parse-boolean #f "FALSE")) + +(test-error 'warning (parse-boolean #f "ANYTHING ELSE")) + + + +(define parse-cal-address + (get-parser 'CAL-ADDRESS)) + +(test-equal "Test uri is passthrough" + 74 (parse-cal-address #f 74)) + + + +(define parse-date (get-parser 'DATE)) + +(test-equal + #2021-12-02 + (parse-date #f "20211202")) +;; TODO negative test here + +(define parse-datetime (get-parser 'DATE-TIME)) + +(test-equal + #2021-12-02T10:20:30 + (parse-datetime + (make-hash-table) + "20211202T102030")) + +;; TODO tests with timezones here +;; TODO test -X-HNH-ORIGINAL here + +;; TODO negative test here + + + +(define parse-duration (get-parser 'DURATION)) + +;; assume someone else tests this one +;; (test-eq (@ (vcomponent duration) parse-duration) +;; parse-duration) + + + +(define parse-float (get-parser 'FLOAT)) + +(test-equal 1.0 (parse-float #f "1.0")) +(test-equal 1 (parse-float #f "1")) +(test-equal 1/2 (parse-float #f "1/2")) + +;; TODO negative test here? + + + +(define parse-integer (get-parser 'INTEGER)) + +(test-equal + "parse integer" + 123456 + (parse-integer #f "123456")) + +(test-equal + "parse bigint" + 123451234512345123456666123456 + (parse-integer + #f + "123451234512345123456666123456")) + +;; TODO is this expected behaivour? +(test-error 'warning (parse-integer #f "failure")) + +(test-error + "Non-integers aren't integers" + 'warning + (parse-integer #f "1.1")) + +(test-equal + "But exact floats are" + 1.0 + (parse-integer #f "1.0")) + + + +(define parse-period (get-parser 'PERIOD)) + +;; TODO + + + +(define parse-recur (get-parser 'RECUR)) + +;; (test-eq (@ (vcomponent recurrence parse) parse-recurrence-rule)) + + + +(define parse-text (get-parser 'TEXT)) + +;; TODO + + + +(define parse-time (get-parser 'TIME)) + +(test-equal + #10:20:30 + (parse-time #f "102030")) +;; TODO negative test here + + + +(define parse-uri (get-parser 'URI)) + +(test-equal "Test uri is passthrough" 74 (parse-uri #f 74)) + + + +(define parse-utc-offset + (get-parser 'UTC-OFFSET)) + +;; TODO diff --git a/tests/test/vcomponent.scm b/tests/test/vcomponent.scm new file mode 100644 index 00000000..d3ee37dc --- /dev/null +++ b/tests/test/vcomponent.scm @@ -0,0 +1,23 @@ +;;; Commentary: +;; Test that vcomponent parsing works at all. +;;; Code: + +(define-module (test vcomponent) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent base) :select (prop)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar))) + +(define ev + (call-with-input-string + "BEGIN:DUMMY\nX-KEY:value\nEND:DUMMY" + parse-calendar)) + +(test-assert (eq? #f (prop ev 'MISSING))) + +(test-assert (prop ev 'X-KEY)) + +(test-equal "value" (prop ev 'X-KEY)) + + diff --git a/tests/test/web-server.scm b/tests/test/web-server.scm new file mode 100644 index 00000000..e5a796b6 --- /dev/null +++ b/tests/test/web-server.scm @@ -0,0 +1,116 @@ +;;; Commentary: +;; Checks that HTTP server can start correctly, and that at least some +;; endpoints return correct information. +;; +;; NOTE This test, when ran in as `tests/run-tests --only web-server.scm' +;; segfaults on Guile 2.2.7, but not on Guile 3.0.8. This doesn't happen +;; when it's run as one of all tests. +;;; Code: + +(define-module (test web-server) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((calp server routes) :select (make-make-routes)) + :use-module ((web server) :select (run-server)) + :use-module ((ice-9 threads) + :select (call-with-new-thread cancel-thread)) + :use-module ((web client) :select (http-get)) + :use-module ((hnh util) :select (let*)) + :use-module ((web response) :select (response-code response-location)) + :use-module ((web uri) :select (build-uri uri-path)) + :use-module ((guile) + :select (socket + inet-pton + bind + make-socket-address + setsockopt + AF_INET + PF_INET + SOL_SOCKET + SO_REUSEADDR + SOCK_STREAM + current-error-port)) + :use-module ((ice-9 format) :select (format)) + :use-module ((web response) :select (build-response))) + +(define host "127.8.9.5") + +(define sock (socket PF_INET SOCK_STREAM 0)) + +(setsockopt sock SOL_SOCKET SO_REUSEADDR 1) + +(define-values + (port sock) + (let ((addr (inet-pton AF_INET host))) + (let loop ((port 8090)) + (catch 'system-error + (lambda () + (bind sock + (make-socket-address AF_INET addr port)) + (values port sock)) + (lambda (err proc fmt args data) + (if (and (not (null? data)) + ;; errno address already in use + (= 98 (car data))) + (loop (1+ port)) + ;; rethrow + (throw err fmt args data))))))) + +(define server-thread + (call-with-new-thread + (lambda () + (catch #t + (lambda () + (run-server + (make-make-routes) + 'http + `(socket: ,sock))) + (lambda args + (format #f "~s~%" args) + (test-assert "Server Crashed" #f))) + ;; This test should always fail, but should never be run + (test-assert "Server returned unexpectedly" #f)))) + +(let* ((response + _ + (catch 'system-error + (lambda () + (http-get + (build-uri 'http host: host port: port))) + (lambda (err proc fmt args data) + (format + (current-error-port) + "~a (in ~a) ~?~%" + err + proc + fmt + args) + (values (build-response code: 500) #f))))) + (test-eqv + "Basic connect" + 200 + (response-code response))) + +(let* ((response + body + (http-get + (build-uri + 'http + host: + host + port: + port + path: + "/today" + query: + "view=week&date=2020-01-04")))) + (test-eqv + "Redirect" + 302 + (response-code response)) + (test-equal + "Fully specified redirect position" + "/week/2020-01-04.html" + (uri-path (response-location response)))) + +(cancel-thread server-thread) diff --git a/tests/test/xcal.scm b/tests/test/xcal.scm new file mode 100644 index 00000000..48d43c59 --- /dev/null +++ b/tests/test/xcal.scm @@ -0,0 +1,58 @@ +;;; Commentary: +;; Basic tests of xcal convertion. +;; Currently only checks that events survive a round trip. +;;; Code: + +(define-module (test xcal) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent formats xcal parse) + :select (sxcal->vcomponent)) + :use-module ((vcomponent formats xcal output) + :select (vcomponent->sxcal)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((hnh util) :select (->)) + :use-module ((vcomponent base) + :select (parameters prop* children))) + +;;; Some different types, same parameters + +(define ev + (call-with-input-string + "BEGIN:VCALENDAR +VERSION:2.0 +PRODID:-//calparse-test +BEGIN:VEVENT +SUMMARY:Test event +DTSTART;TZID=Europe/Stockholm:20200625T133000 +DTEND:20200625T143000Z +DTSTAMP:20200609T131418Z +UID:1 +SEQUENCE:0 +CREATED:20200609T081725Z +DESCRIPTION:Short description +LAST-MODIFIED:20200609T081725Z +STATUS;X-TEST-PARAM=10:CONFIRMED +TRANSP:OPAQUE +END:VEVENT +END:VCALENDAR" + parse-calendar)) + +(define twice-converted + (-> ev vcomponent->sxcal sxcal->vcomponent)) + +;;; NOTE both these tests may fail since neither properties nor parameters are ordered sorted. + +(test-equal + "c->x & c->x->c->x" + (vcomponent->sxcal ev) + (vcomponent->sxcal twice-converted)) + +(test-equal + "xcal parameters" + '((X-TEST-PARAM "10")) + (parameters + (prop* (car (children twice-converted)) 'STATUS))) + + diff --git a/tests/test/xml-namespace.scm b/tests/test/xml-namespace.scm new file mode 100644 index 00000000..09402ceb --- /dev/null +++ b/tests/test/xml-namespace.scm @@ -0,0 +1,36 @@ +(define-module (test xml-namespace) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((sxml namespace) :select (move-to-namespace))) + +(test-equal + "Move unnamespaced to namespace" + '(NEW:test) + (move-to-namespace '(test) '((#f . NEW)))) + +(test-equal + "Swap namespaces" + '(b:a (a:b)) + (move-to-namespace + '(a:a (b:b)) + '((a . b) (b . a)))) + +(test-equal + "Remove all namespaces" + '(a (b)) + (move-to-namespace '(a:a (b:b)) #f)) + +(test-equal + "Move everything to one namespace" + '(c:a (c:b)) + (move-to-namespace '(a:a (b:b)) 'c)) + +(test-equal + "Partial namespace change" + '(c:a (b:b)) + (move-to-namespace '(a:a (b:b)) '((a . c)))) + +(test-equal + "Remove specific namespace" + '(a:a (b)) + (move-to-namespace '(a:a (b:b)) '((b . #f)))) diff --git a/tests/tz.scm b/tests/tz.scm deleted file mode 100644 index 1cbb1842..00000000 --- a/tests/tz.scm +++ /dev/null @@ -1,57 +0,0 @@ -;;; 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: - -(((datetime) - parse-ics-datetime - datetime date time - datetime->unix-time - unix-time->datetime - get-datetime) - ((hnh util) let-env)) - -;; London alternates between +0000 and +0100 -(let-env ((TZ "Europe/London")) - (test-equal "London winter" - #2020-01-12T13:30:00 - (get-datetime (parse-ics-datetime "20200112T133000Z"))) - (test-equal "London summer" - #2020-06-12T14:30:00 - (get-datetime (parse-ics-datetime "20200612T133000Z")))) - -;; Stockholm alternates between +0100 and +0200 -(let-env ((TZ "Europe/Stockholm")) - (test-equal "Stockholm winter" - #2020-01-12T14:30:00 - (get-datetime (parse-ics-datetime "20200112T133000Z"))) - (test-equal "Stockholm summer" - #2020-06-12T15:30: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 - #1970-01-01T00:00:00Z - (unix-time->datetime 0)) diff --git a/tests/util.scm b/tests/util.scm deleted file mode 100644 index 37711a2e..00000000 --- a/tests/util.scm +++ /dev/null @@ -1,81 +0,0 @@ -;;; Commentary: -;; Checks some prodecuders from (hnh util) -;;; Code: - -(((hnh util) filter-sorted set/r! - find-min find-max span-upto - iterate ->string ->quoted-string - begin1) - ((hnh util path) path-append path-split) - ((ice-9 ports) with-output-to-string) - ((guile) set!) - ) - -(test-equal "Filter sorted" - '(3 4 5) - (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10))) - -(test-equal "set/r! = single" - #f - (let ((x #t)) - (set/r! x = not))) - -(test-error - 'syntax-error - (test-read-eval-string "(set/r! x err not)")) - - -(call-with-values (lambda () (find-min (iota 10))) - (lambda (extreme rest) - (test-equal "Found correct minimum" - 0 extreme) - (test-equal "Removed \"something\" from the set" - 9 (length rest)))) - - -(call-with-values (lambda () (find-max '("Hello" "Test" "Something long") string-length)) - (lambda (extreme rest) - (test-equal "Found the longest string" "Something long" extreme) - (test-equal "Removed the string" 2 (length rest)) - (test-assert "Other members left 1" (member "Hello" rest)) - (test-assert "Other members left 2" (member "Test" rest)))) - - -(test-error 'misc-error (find-extreme '())) - -(call-with-values (lambda () (span-upto 2 char-numeric? (string->list "123456"))) - (lambda (head tail) - (test-equal '(#\1 #\2) head) - (test-equal '(#\3 #\4 #\5 #\6) tail))) - -(call-with-values (lambda () (span-upto 2 char-numeric? (string->list "H123456"))) - (lambda (head tail) - (test-equal '() head) - (test-equal '(#\H #\1 #\2 #\3 #\4 #\5 #\6) tail))) - - -(let ((value #f)) - (test-equal "begin1 return value" "Hello" - (begin1 "Hello" (set! value "World"))) - (test-equal "begin1 side effects" "World" value)) - - -(test-equal 0 (iterate 1- zero? 10)) - -(test-equal "5" (->string 5)) -(test-equal "5" (->string "5")) - -(test-equal "5" (->quoted-string 5)) -(test-equal "\"5\"" (->quoted-string "5")) - -(test-equal "no slashes" "home/user" (path-append "home" "user")) -(test-equal "no slashes, absolute" "/home/user" (path-append "" "home" "user")) -(test-equal "slashes in one component, absolute" "/home/user" (path-append "" "/home/" "user")) -(test-equal "slashes in one component, absolute due to first" "/home/user" (path-append "/home/" "user")) -(test-equal "Slashes in both" "home/user" (path-append "home/" "/user")) -(test-equal "root" "/" (path-append "")) - -(test-equal '("usr" "lib" "test") (path-split "usr/lib/test")) -(test-equal '("usr" "lib" "test") (path-split "usr/lib/test/")) -(test-equal '("" "usr" "lib" "test") (path-split "/usr/lib/test")) -(test-equal '("" "usr" "lib" "test") (path-split "//usr////lib/test")) diff --git a/tests/vcomponent-control.scm b/tests/vcomponent-control.scm deleted file mode 100644 index 1f4d6801..00000000 --- a/tests/vcomponent-control.scm +++ /dev/null @@ -1,29 +0,0 @@ -;;; Commentary: -;; Tests that with-replaced-properties work. -;;; Code: - -(((vcomponent util control) with-replaced-properties) - ((vcomponent formats ical parse) parse-calendar) - ((vcomponent base) prop)) - - - -(define ev (call-with-input-string - "BEGIN:DUMMY -X-KEY:value -END:DUMMY" - parse-calendar)) - -;; Test that temoraries are set and restored -(test-equal "value" (prop ev 'X-KEY)) -(with-replaced-properties (ev (X-KEY "other")) - (test-equal "other" (prop ev 'X-KEY))) -(test-equal "value" (prop ev 'X-KEY)) - -;; Test that they are restored on non-local exit -(catch #t - (lambda () - (with-replaced-properties (ev (X-KEY "other")) - (throw 'any))) - (lambda _ - (test-equal "value" (prop ev 'X-KEY)))) diff --git a/tests/vcomponent-datetime.scm b/tests/vcomponent-datetime.scm deleted file mode 100644 index 0f410979..00000000 --- a/tests/vcomponent-datetime.scm +++ /dev/null @@ -1,40 +0,0 @@ -;;; Commentary: -;; Tests that event-clamping (checking how long part of an event -;; overlaps another time span) works. -;;; Code: - -(((datetime) - date time - datetime) - ((vcomponent datetime) - event-length/clamped) - ((vcomponent formats ical parse) parse-calendar) - ) - -(define ev (call-with-input-string - "BEGIN:VEVENT -DTSTART:20200329T170000 -DTEND:20200401T100000 -END:VEVENT" - parse-calendar)) - -;; |-----------------| test interval -;; |----------| event interval - -(test-equal "Correct clamping" - (datetime time: (time hour: 7)) ; 2020-03-29T17:00 - 2020-03-30T00:00 - (event-length/clamped - #2020-03-23 ; a time way before the start of the event - #2020-03-29 ; a time slightly after the end of the event - ev)) - -(define utc-ev (call-with-input-string - "BEGIN:VEVENT -DTSTART:20200329T150000Z -DTEND:20200401T080000Z -END:VEVENT" - parse-calendar)) - -(test-equal "Correct clamping UTC" - (datetime time: (time hour: 7)) - (event-length/clamped #2020-03-23 #2020-03-29 ev)) diff --git a/tests/vcomponent-formats-common-types.scm b/tests/vcomponent-formats-common-types.scm deleted file mode 100644 index d9c80ff9..00000000 --- a/tests/vcomponent-formats-common-types.scm +++ /dev/null @@ -1,115 +0,0 @@ -(((vcomponent formats common types) - get-parser) - ((datetime) date time datetime)) - - - -(define parse-binary (get-parser 'BINARY)) -;; TODO - - - -(define parse-boolean (get-parser 'BOOLEAN)) - -(test-equal #t (parse-boolean #f "TRUE")) -(test-equal #f (parse-boolean #f "FALSE")) - -(test-error 'warning (parse-boolean #f "ANYTHING ELSE")) - - - -(define parse-cal-address (get-parser 'CAL-ADDRESS)) - -(test-equal "Test uri is passthrough" 74 (parse-cal-address #f 74)) - - - -(define parse-date (get-parser 'DATE)) - -(test-equal #2021-12-02 (parse-date #f "20211202")) -;; TODO negative test here - - - -(define parse-datetime (get-parser 'DATE-TIME)) - -(test-equal #2021-12-02T10:20:30 - (parse-datetime (make-hash-table) "20211202T102030")) - -;; TODO tests with timezones here -;; TODO test -X-HNH-ORIGINAL here - -;; TODO negative test here - - - -(define parse-duration (get-parser 'DURATION)) - -;; assume someone else tests this one -;; (test-eq (@ (vcomponent duration) parse-duration) -;; parse-duration) - - - -(define parse-float (get-parser 'FLOAT)) - -(test-equal 1.0 (parse-float #f "1.0")) -(test-equal 1 (parse-float #f "1")) -(test-equal 1/2 (parse-float #f "1/2")) - -;; TODO negative test here? - - - -(define parse-integer (get-parser 'INTEGER)) - -(test-equal "parse integer" 123456 (parse-integer #f "123456")) -(test-equal "parse bigint" 123451234512345123456666123456 - (parse-integer #f "123451234512345123456666123456")) - -;; TODO is this expected behaivour? -(test-error 'warning (parse-integer #f "failure")) - -(test-error - "Non-integers aren't integers" - 'warning (parse-integer #f "1.1")) - -(test-equal "But exact floats are" - 1.0 (parse-integer #f "1.0")) - - - -(define parse-period (get-parser 'PERIOD)) - -;; TODO - - - -(define parse-recur (get-parser 'RECUR)) - -;; (test-eq (@ (vcomponent recurrence parse) parse-recurrence-rule)) - - - -(define parse-text (get-parser 'TEXT)) - -;; TODO - - - -(define parse-time (get-parser 'TIME)) - -(test-equal #10:20:30 (parse-time #f "102030")) -;; TODO negative test here - - - -(define parse-uri (get-parser 'URI)) - -(test-equal "Test uri is passthrough" 74 (parse-uri #f 74)) - - - -(define parse-utc-offset (get-parser 'UTC-OFFSET)) - -;; TODO diff --git a/tests/vcomponent.scm b/tests/vcomponent.scm deleted file mode 100644 index acdb970b..00000000 --- a/tests/vcomponent.scm +++ /dev/null @@ -1,16 +0,0 @@ -;;; Commentary: -;; Test that vcomponent parsing works at all. -;;; Code: - -(((vcomponent base) prop) - ((vcomponent formats ical parse) parse-calendar)) - -(define ev (call-with-input-string - "BEGIN:DUMMY -X-KEY:value -END:DUMMY" - parse-calendar)) - -(test-assert (eq? #f (prop ev 'MISSING))) -(test-assert (prop ev 'X-KEY)) -(test-equal "value" (prop ev 'X-KEY)) diff --git a/tests/web-server.scm b/tests/web-server.scm deleted file mode 100644 index 837ca3ab..00000000 --- a/tests/web-server.scm +++ /dev/null @@ -1,61 +0,0 @@ -;;; Commentary: -;; Checks that HTTP server can start correctly, and that at least some -;; endpoints return correct information. -;; -;; NOTE This test, when ran in as `tests/run-tests --only web-server.scm' -;; segfaults on Guile 2.2.7, but not on Guile 3.0.8. This doesn't happen -;; when it's run as one of all tests. -;;; Code: - -(((calp server routes) make-make-routes) - ((web server) run-server) - ((ice-9 threads) call-with-new-thread cancel-thread) - ((web client) http-get) - ((hnh util) let*) - ((web response) response-code response-location) - ((web uri) build-uri uri-path) - ((guile) - socket inet-pton bind make-socket-address setsockopt - AF_INET PF_INET SOL_SOCKET SO_REUSEADDR SOCK_STREAM - ) - ) - - -(define host "127.8.9.5") -(define sock (socket PF_INET SOCK_STREAM 0)) -(setsockopt sock SOL_SOCKET SO_REUSEADDR 1) - -(define-values (port sock) - (let ((addr (inet-pton AF_INET host))) - (let loop ((port 8090)) - (catch 'system-error - (lambda () - (bind sock (make-socket-address AF_INET addr port)) - (values port sock)) - (lambda (err proc fmt args data) - (if (and (not (null? data)) - ;; errno address already in use - (= 98 (car data))) - (loop (1+ port)) - ;; rethrow - (throw err fmt args data))))))) - -(define server-thread - (call-with-new-thread - (lambda () - (run-server (make-make-routes) 'http `(socket: ,sock)) - ;; This test should always fail, but should never be run - (test-assert "Server returned unexpectedly" #f)))) - -(let* ((response body (http-get (build-uri 'http host: host port: port)))) - (test-eqv "Basic connect" 200 (response-code response))) - -(let* ((response body (http-get (build-uri 'http host: host port: port - path: "/today" - query: "view=week&date=2020-01-04")))) - (test-eqv "Redirect" - 302 (response-code response)) - (test-equal "Fully specified redirect position" - "/week/2020-01-04.html" (uri-path (response-location response)))) - -(cancel-thread server-thread) diff --git a/tests/xcal.scm b/tests/xcal.scm deleted file mode 100644 index 6e80405b..00000000 --- a/tests/xcal.scm +++ /dev/null @@ -1,50 +0,0 @@ -;;; Commentary: -;; Basic tests of xcal convertion. -;; Currently only checks that events survive a round trip. -;;; Code: - -(((vcomponent formats xcal parse) sxcal->vcomponent) - ((vcomponent formats xcal output) vcomponent->sxcal) - ((vcomponent formats ical parse) parse-calendar) - ((hnh util) ->) - ((vcomponent base) - parameters prop* children) - ) - -;;; Some different types, same parameters - -(define ev - (call-with-input-string "BEGIN:VCALENDAR -VERSION:2.0 -PRODID:-//calparse-test -BEGIN:VEVENT -SUMMARY:Test event -DTSTART;TZID=Europe/Stockholm:20200625T133000 -DTEND:20200625T143000Z -DTSTAMP:20200609T131418Z -UID:1 -SEQUENCE:0 -CREATED:20200609T081725Z -DESCRIPTION:Short description -LAST-MODIFIED:20200609T081725Z -STATUS;X-TEST-PARAM=10:CONFIRMED -TRANSP:OPAQUE -END:VEVENT -END:VCALENDAR" - parse-calendar)) - -(define twice-converted - (-> ev - vcomponent->sxcal - sxcal->vcomponent)) - -;;; NOTE both these tests may fail since neither properties nor parameters are ordered sorted. - -(test-equal "c->x & c->x->c->x" - (vcomponent->sxcal ev) - (vcomponent->sxcal twice-converted)) - -(test-equal "xcal parameters" - '((X-TEST-PARAM "10")) - (parameters (prop* (car (children twice-converted)) - 'STATUS))) diff --git a/tests/xml-namespace.scm b/tests/xml-namespace.scm deleted file mode 100644 index 74053fd8..00000000 --- a/tests/xml-namespace.scm +++ /dev/null @@ -1,30 +0,0 @@ -(((sxml namespace) - move-to-namespace - )) - - -(test-equal "Move unnamespaced to namespace" - '(NEW:test) - (move-to-namespace '(test) '((#f . NEW)))) - -(test-equal "Swap namespaces" - '(b:a (a:b)) - (move-to-namespace '(a:a (b:b)) '((a . b) (b . a)))) - -(test-equal "Remove all namespaces" - '(a (b)) - (move-to-namespace '(a:a (b:b)) #f)) - -(test-equal "Move everything to one namespace" - '(c:a (c:b)) - (move-to-namespace '(a:a (b:b)) 'c)) - -(test-equal "Partial namespace change" - '(c:a (b:b)) - (move-to-namespace '(a:a (b:b)) - '((a . c)))) - -(test-equal "Remove specific namespace" - '(a:a (b)) - (move-to-namespace '(a:a (b:b)) - '((b . #f)))) -- cgit v1.2.3