diff options
Diffstat (limited to 'tests/unit')
36 files changed, 6181 insertions, 0 deletions
diff --git a/tests/unit/c/cpp.scm b/tests/unit/c/cpp.scm new file mode 100644 index 00000000..43ad0144 --- /dev/null +++ b/tests/unit/c/cpp.scm @@ -0,0 +1,41 @@ +;;; 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")) + + +'((c lex) + (c parse)) diff --git a/tests/unit/datetime/datetime.scm b/tests/unit/datetime/datetime.scm new file mode 100644 index 00000000..9f32d4a1 --- /dev/null +++ b/tests/unit/datetime/datetime.scm @@ -0,0 +1,812 @@ +(define-module (test datetime) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module ((srfi srfi-41) + :select (stream->list stream-take)) + :use-module (datetime) + :use-module ((ice-9 format) :select (format)) + :use-module ((ice-9 i18n) :select (make-locale)) + :use-module ((guile) :select (LC_CTYPE LC_TIME))) + +;;; Skipped since the code generating the (expected) error is disabled, due to +;;; optional fields at the end of string. See the (null? str) case is +;;; datetime->string +(test-expect-fail "Premature end of string to parse") + +;;; Global locale objects, to save all tests from creating them +(define en_US (make-locale (list LC_CTYPE LC_TIME) "en_US.UTF-8")) +(define sv_SE (make-locale (list LC_CTYPE LC_TIME) "sv_SE.UTF-8")) + +;;; These tests begin by testing the basic objects, +;;; followed by the string parser. +;;; This to finally test the read syntax, to be able to +;;; us it in the rest of the tests. + +(test-group "Creation of basic objects" + (test-group "Date" + (test-group "Empty date" + (let ((d (date))) + (test-assert "Date creates date objects" (date? d)) + (test-equal "Year is zero" 0 (year d)) + (test-equal "Month is zero" 0 (month d)) + (test-equal "Day is zero" 0 (day d)) + (test-assert "Date-zero? agrees" (date-zero? d)))) + + (test-group "Date with keys" + ;; Implicitly tests that month and day can go above + ;; "regular" bounds + (let ((d (date day: 40 month: 20 year: 10))) + (test-assert "Date creation still works" (date? d)) + (test-equal "Year is stored" 10 (year d)) + (test-equal "Month is stored" 20 (month d)) + (test-equal "Day is stored" 40 (day d)))) + + (test-group "Can't create date with non-integer components" + (test-error "Invalid year" 'wrong-type-arg (date year: #f)) + (test-error "Invalid month" 'wrong-type-arg (date month: #f)) + (test-error "Invalid day" 'wrong-type-arg (date day: #f)))) + + (test-group "Time" + (test-group "Empty time" + (let ((t (time))) + (test-assert "Time creates time objects" (time? t)) + (test-equal "hour is zero" 0 (hour t)) + (test-equal "minute is zero" 0 (minute t)) + (test-equal "second is zero" 0 (second t)) + (test-assert "Time zero agrees" (time-zero? t)))) + + (test-group "Time with keys" + (let ((t (time second: 10 minute: 20 hour: 30))) + (test-assert "Time creation still works" (time? t)) + (test-equal "Hour is stored" 30 (hour t)) + (test-equal "Minute is stored" 20 (minute t)) + (test-equal "Second is stored" 10 (second t)))) + + (test-group "Can't create time with non-integer components" + (test-error "Invalid hour" 'wrong-type-arg (time hour: #f)) + (test-error "Invalid minute" 'wrong-type-arg (time minute: #f)) + (test-error "Invalid second" 'wrong-type-arg (time second: #f)))) + + (test-group "Datetime" + (let () + (test-group "Empty datetime" + (let ((dt (datetime))) + (test-assert "Datetime date is date" (date? (datetime-date dt))) + (test-assert "Datetime date is zero" (date-zero? (datetime-date dt))) + (test-assert "Datetime time is time" (time? (datetime-time dt))) + (test-assert "Datetime time is zero" (time-zero? (datetime-time dt))) + (test-eqv "Defalut timezone is #f" #f (tz dt)))) + + (test-group "Datetime with keys" + (let ((dt (datetime date: (date day: 10) + time: (time minute: 20)))) + (test-equal "Given date is stored" + 10 (day (datetime-date dt))) + (test-equal "Given time is stored" + 20 (minute (datetime-time dt)))) + (test-error "Date must be a date" 'wrong-type-arg (datetime date: 1)) + (test-error "Date must be a date" 'wrong-type-arg (datetime date: (time))) + (test-assert "Date: #f gives still constructs a date" (date? (datetime-date (datetime date: #f)))) + (test-error "Time must be a time" 'wrong-type-arg (datetime time: 1)) + (test-error "Time must be a time" 'wrong-type-arg (datetime time: (date))) + (test-assert "Time: #f gives still constructs a time" (time? (datetime-time (datetime time: #f)))) + + (let ((dt (datetime hour: 20 day: 30))) + (test-equal "Time objects can be implicitly created" 20 (hour (datetime-time dt))) + (test-equal "Date objects can be implicitly created" 30 (day (datetime-date dt)))) + (let ((dt (datetime day: 30 time: (time hour: 20)))) + (test-equal "\"Upper\" and \"lower\" keys can be mixed" + 20 (hour (datetime-time dt))) + (test-equal "\"Upper\" and \"lower\" keys can be mixed" + 30 (day (datetime-date dt)))) + + (let ((dt (datetime hour: 30 time: (time hour: 20)))) + (test-equal "time: has priority over hour: (and the like)" + 20 (hour (datetime-time dt))))) + (let ((dt (datetime day: 30 date: (date day: 20)))) + (test-equal "date: has priority over day: (and the like)" + 20 (day (datetime-date dt))))))) + +;; Before the general parser, since it's a dependency string->datetime. +(test-group "Parse Month" + + (test-equal "Parse full month name" jan (parse-month "January" en_US)) + (test-equal "Parse full weird case" jan (parse-month "jaNuaRy" en_US)) + (test-equal "Parse partial month name" jan (parse-month "Jan" en_US)) + (test-equal "Failing parse of month name" -1 (parse-month "Unknown" en_US)) + (test-equal "Overlap gives earliest month" mar (parse-month "m" en_US)) + + (test-equal "Parse month with different locale" may (parse-month "maj" sv_SE))) + + +(test-group "Parser" + (test-group "Simple individual rules" + (test-group "Year" + (test-equal "~Y year" (datetime year: 2020) (string->datetime "2020" "~Y")) + (test-equal "~Y year single digit" (datetime year: 2) (string->datetime "2" "~Y")) + (test-equal "~Y year leading zero" (datetime year: 2) (string->datetime "02" "~Y")) + (test-error "~Y parses at max four digits" 'misc-error (string->datetime "14411" "~Y"))) + + (test-group "Month" + (test-equal "~m month" (datetime month: 10) (string->datetime "10" "~m")) + (test-equal "~m month single digit" (datetime month: 1) (string->datetime "1" "~m")) + (test-equal "~m month leading zero" (datetime month: 1) (string->datetime "01" "~m")) + (test-error "~m parses at max two digits" 'misc-error (string->datetime "111" "~m"))) + + ;; Extra tests are skipped for these, since they are shared with Month + (test-equal "~d day" (datetime day: 20) (string->datetime "20" "~d")) + (test-equal "~H hour" (datetime hour: 15) (string->datetime "15" "~H")) + (test-equal "~M minute" (datetime minute: 30) (string->datetime "30" "~M")) + (test-equal "~S second" (datetime second: 59) (string->datetime "59" "~S"))) + + + (test-equal "Literal character" (datetime) (string->datetime "T" "T")) + (test-equal "~~ '~'" (datetime) (string->datetime "~" "~~")) + (test-error "Mismatched literal ~" 'misc-error (string->datetime "A" "~~")) + + (test-error "Stray ~ at end of fmt" 'misc-error (string->datetime "~" "~")) + (test-error "Stray ~ in middle of fmt" 'misc-error (string->datetime "~ 1" "~ ~d")) + (test-error "Unknown escape" 'misc-error (string->datetime "10" "~x")) + (test-error "Premature end of string to parse" 'misc-error (string->datetime "" "~Y")) + (test-error "Wrong Literal character" 'misc-error (string->datetime "T" "Z")) + + + ;; Does the parser continue correctly + (test-group "Tokens following each other" + (test-equal "Year indirectly followed by month" + (datetime year: 2020 month: 1) + (string->datetime "2020-01" "~Y-~m")) + ;; Does the parser handle tokens without delimiters, instead going by their max size + (test-equal "Year directly follewed by month" + (datetime year: 2020 month: 1) + (string->datetime "202001" "~Y~m"))) + + + (test-group "Timezone" + (test-equal "~Z 'Z'" + (datetime tz: "UTC") (string->datetime "Z" "~Z")) + (test-equal "~Z Is optional" + (datetime) (string->datetime "" "~Z")) + (test-equal "~Z Is optional with stuff after" + (datetime hour: 20) (string->datetime "20" "~Z~H")) + ;; This was earlier a bug + (test-equal "Zoneinfo is kept while not at end" + (datetime year: 2020 tz: "UTC") + (string->datetime "Z2020" "~Z~Y"))) + + + (test-group "Month by name" + ;; ~b, ~B, and ~h all does the same thing, and exists for symmetry with + ;; datetime->string (where they don't do the exact same thing). Each is used + ;; at least once below to ensure that they all work. + (test-equal "Standalone month, and at end" + (datetime month: 1) + (string->datetime "Jan" "~b" en_US)) + + ;; Separate test from above, since month does the check itself + (test-error "Stray ~ after month" + 'misc-error (string->datetime "Jan" "~b~" en_US)) + + (test-equal "Month with explicit ~ after" + (datetime month: mar) + (string->datetime "M~" "~B~~" en_US)) + + (test-error "Month with other specifier directly after" + 'misc-error (string->datetime "January" "~b~b")) + + (test-equal "Month with other explict char after" + (datetime month: mar) + (string->datetime "Mar|" "~h|" en_US)) + + (test-equal "Locale information is used" + (datetime month: may) + (string->datetime "Maj" "~h" sv_SE))) + + ;; TODO AM/PM string ~p + + (test-group "Complete parses" + (test-equal "Parse complete ISO date" + (datetime year: 2020 month: 3 day: 10) + (string->datetime "2020-03-10" "~Y-~m-~d")) + + (test-equal "Parse complete ISO time" + (datetime hour: 10 minute: 20 second: 30) + (string->datetime "10:20:30" "~H:~M:~S")) + + (test-equal "Parse complete ISO date-time" + (datetime year: 2020 month: 3 day: 10 + hour: 10 minute: 20 second: 30) + (string->datetime "2020-03-10T10:20:30" + "~Y-~m-~dT~H:~M:~S"))) + + (test-group "string->datetime default format-specifier" + (test-equal "Default date-time format-specifier takes ISO date-times" + (datetime year: 2020 month: 3 day: 10 + hour: 10 minute: 20 second: 30) + (string->datetime "2020-03-10T10:20:30")) + + (test-equal "Default date-time format-specifier takes ISO date-times (with zone)" + (datetime year: 2020 month: 3 day: 10 + hour: 10 minute: 20 second: 30 + tz: "UTC") + (string->datetime "2020-03-10T10:20:30Z"))) + + + (test-group "string->time" + (test-assert "String->time returns time objects" + (time? (string->time "10" "~H"))) + + (test-equal "String->time complete parse" + (time hour: 10 minute: 20 second: 30) + (string->time "10:20:30" "~H:~M:~S")) + + (test-equal "String->time complete parse, default format-specifier" + (time hour: 10 minute: 20 second: 30) + (string->time "10:20:30"))) + + (test-group "string->date" + (test-assert "String->date returns time objects" + (date? (string->date "10" "~Y"))) + + (test-equal "String->date complete parse" + (date year: 2020 month: 3 day: 10) + (string->date "2020-03-10" "~Y-~m-~d")) + + (test-equal "String->date complete parse, default format-specifier" + (date year: 2020 month: 3 day: 10) + (string->date "2020-03-10"))) + + (test-group "Pre-specified parsers" + (test-group "ICS (RFC 5545)" + (test-equal "date" + (date year: 2020 month: 10 day: 20) + (parse-ics-date "20201020")) + (test-equal "time" + (time hour: 10 minute: 20 second: 30) + (parse-ics-time "102030")) + (test-equal "datetime" + (datetime year: 2020 month: 10 day: 20 + hour: 10 minute: 20 second: 30) + (parse-ics-datetime "20201020T102030")) + (test-equal "datetime (with zone)" + (datetime year: 2020 month: 10 day: 20 + hour: 10 minute: 20 second: 30 + tz: "UTC") + (parse-ics-datetime "20201020T102030Z"))) + + (test-group "ISO" + (test-equal "date" + (date year: 2020 month: 10 day: 20) + (parse-iso-date "2020-10-20")) + (test-equal "time" + (time hour: 10 minute: 20 second: 30) + (parse-iso-time "10:20:30")) + (test-equal "datetime" + (datetime year: 2020 month: 10 day: 20 + hour: 10 minute: 20 second: 30) + (parse-iso-datetime "2020-10-20T10:20:30"))) + + ;; Parse freeform date + ) + + (test-group "string->date/-time" + (test-equal "Date like gives date" + (date year: 2020 month: 10 day: 20) + (string->date/-time "2020-10-20")) + (test-equal "Time like gives time" + (time hour: 10 minute: 20 second: 30) + (string->date/-time "10:20:30")) + (test-equal "Datetime like gives datetime" + (datetime year: 2020 month: 10 day: 20 + hour: 10 minute: 20 second: 30) + (string->date/-time "2020-10-20T10:20:30")) + + ;; These are disabled since trailing fmt is allowed + ;; (test-error "Bad date-like crashes" + ;; 'misc-error (string->date/-time "2020-10")) + ;; (test-error "Bad time-like crashes" + ;; 'misc-error (string->date/-time "20:10")) + (test-error "Really bad crashes" + 'misc-error (string->date/-time "Hello")) + )) + + +(test-group "Reader extensions" + + ;; All tests have a list variant, to ensure that it plays nice with the rest + ;; of scheme's syntax + + (test-equal "Basic time read syntax" + (time hour: 10 minute: 20 second: 30) + (test-read-eval-string "#10:20:30")) + + (test-equal "Basic time read syntax in list" + (list (time hour: 10 minute: 20 second: 30)) + (test-read-eval-string "(list #10:20:30)")) + + (test-equal "Basic date read syntax" + (date year: 2020 month: 3 day: 10) + (test-read-eval-string "#2020-03-10")) + + (test-equal "Basic date read syntax in list" + (list (date year: 2020 month: 3 day: 10)) + (test-read-eval-string "(list #2020-03-10)")) + + (test-equal "Basic datetime read syntax" + (datetime date: (date year: 2020 month: 3 day: 10) + time: (time hour: 10 minute: 20 second: 30)) + (test-read-eval-string "#2020-03-10T10:20:30")) + + (test-equal "Basic datetime read syntax in list" + (list (datetime date: (date year: 2020 month: 3 day: 10) + time: (time hour: 10 minute: 20 second: 30))) + (test-read-eval-string "(list #2020-03-10T10:20:30)")) + + (test-equal "Basic datetime read syntax with Z" + (datetime date: (date year: 2020 month: 3 day: 10) + time: (time hour: 10 minute: 20 second: 30) + tz: "UTC") + (test-read-eval-string "#2020-03-10T10:20:30Z")) + + (test-equal "Basic datetime read syntax with Z in list" + (list + (datetime date: (date year: 2020 month: 3 day: 10) + time: (time hour: 10 minute: 20 second: 30) + tz: "UTC")) + (test-read-eval-string "(list #2020-03-10T10:20:30Z)")) + ) + + + + +(test-equal "Datetime->unix-time" + 1656005146 (datetime->unix-time (datetime year: 2022 month: 06 day: 23 hour: 17 minute: 25 second: 46 tz: "UTC"))) + +(test-equal "Datetime->unix-time before epoch" + -62167219200 + (datetime->unix-time (datetime year: 0000 month: 01 day: 01 hour: 00 minute: 00 second: 00 tz: "UTC"))) + +(test-equal "unix-time->datetime" (datetime year: 2020 month: 09 day: 13 hour: 12 minute: 26 second: 40 tz: "UTC") + (unix-time->datetime 1600000000)) +(test-equal "unix-time->datetime on epoch" (datetime year: 1970 month: 01 day: 01 hour: 00 minute: 00 second: 00 tz: "UTC") + (unix-time->datetime 0)) +(test-equal "unix-time->datetime before epoch" (datetime year: 1919 month: 04 day: 20 hour: 11 minute: 33 second: 20 tz: "UTC") + (unix-time->datetime -1600000000)) + +;; (unix-time->datetime (expt 2 31)) ; => (datetime year: 2038 month: 01 day: 19 hour: 03 minute: 14 second: 08 tz: "UTC") +;; (unix-time->datetime (1+ (expt 2 31))) ; => (datetime year: 2038 month: 01 day: 19 hour: 03 minute: 14 second: 09 tz: "UTC") +;; (unix-time->datetime (- (expt 2 31))) ; => (datetime year: 1901 month: 12 day: 13 hour: 20 minute: 45 second: 52 tz: "UTC") + + +(test-assert "Current datetime returns a datetime" + (datetime? (current-datetime))) +(test-equal "Current datetime returns with tz: UTC" + "UTC" (tz (current-datetime))) +(test-assert "Current-date returns a date" + (date? (current-date))) + + +;; TODO write these, also, check connection to get-time% +get-datetime +as-date +as-time +as-datetime + +(test-group "Leap years" + (test-assert "Most years are't leap years" (not (leap-year? 1999))) + (test-assert "Except if it's divisible by 4" (leap-year? 2020)) + (test-assert "But not by 100" (not (leap-year? 1900))) + (test-assert "Except if also divisible by 400" (leap-year? 2000))) + +(test-assert "31 days in most month" (days-in-month (date month: jan))) +(test-assert "30 days in some month" (days-in-month (date month: apr))) +(test-assert "28 days in februrary on regular year" + (days-in-month (date month: feb year: 2022))) +(test-assert "29 days in februrary on leap year" + (days-in-month (date month: feb year: 2000))) +(test-error "To low month" 'out-of-range (days-in-month (date month: 0))) +(test-error "To high month" 'out-of-range (days-in-month (date month: 13))) + +(test-equal "365 days in regular year" 365 (days-in-year (date year: 2022))) +(test-equal "366 days in leap year" 366 (days-in-year (date year: 2000))) + +(test-equal "Start of month" (date year: 2020 month: 01 day: 01) (start-of-month (date year: 2020 month: 01 day: 15))) +(test-equal "End of month" (date year: 2000 month: 02 day: 29) (end-of-month (date year: 2000 month: 02 day: 01))) + +(test-equal "Start of year" (date year: 2020 month: 01 day: 01) (start-of-year (date year: 2020 month: 12 day: 31))) +;; Note that end-of-year (apparently) doesn't exist + +(test-group "Date streams" + (test-equal "Day stream" + (list (date year: 2020 month: 01 day: 01) (date year: 2020 month: 01 day: 02) (date year: 2020 month: 01 day: 03) (date year: 2020 month: 01 day: 04) (date year: 2020 month: 01 day: 05)) + (stream->list 5 (day-stream (date year: 2020 month: 01 day: 01)))) + (test-equal "Week stream" + (list (date year: 2020 month: 01 day: 01) (date year: 2020 month: 02 day: 01) (date year: 2020 month: 03 day: 01) (date year: 2020 month: 04 day: 01) (date year: 2020 month: 05 day: 01)) + (stream->list 5 (month-stream (date year: 2020 month: 01 day: 01)))) + (test-equal "Month stream" + (list (date year: 2020 month: 01 day: 01) (date year: 2020 month: 01 day: 08) (date year: 2020 month: 01 day: 15) (date year: 2020 month: 01 day: 22) (date year: 2020 month: 01 day: 29)) + (stream->list 5 (week-stream (date year: 2020 month: 01 day: 01))))) + +;; See time< tests for more context +(test-group "Min/max" + (test-equal "Time min" + (time hour: 07 minute: 40 second: 50) (time-min (time hour: 10 minute: 20 second: 30) (time hour: 07 minute: 40 second: 50))) + (test-equal "Time max" + (time hour: 10 minute: 20 second: 30) (time-max (time hour: 10 minute: 20 second: 30) (time hour: 07 minute: 40 second: 50))) + + (test-equal "Date min" + (date year: 2020 month: 02 day: 02) (date-min (date year: 2020 month: 02 day: 02) (date year: 2020 month: 03 day: 01))) + (test-equal "Date max" + (date year: 2020 month: 03 day: 01) (date-max (date year: 2020 month: 02 day: 02) (date year: 2020 month: 03 day: 01))) + + (test-equal "Datetime min" + (datetime year: 2020 month: 02 day: 02 hour: 10 minute: 20 second: 30) (datetime-min (datetime year: 2020 month: 02 day: 02 hour: 10 minute: 20 second: 30) (datetime year: 2020 month: 03 day: 01 hour: 07 minute: 40 second: 50))) + (test-equal "Datetime max" + (datetime year: 2020 month: 03 day: 01 hour: 07 minute: 40 second: 50) (datetime-max (datetime year: 2020 month: 02 day: 02 hour: 10 minute: 20 second: 30) (datetime year: 2020 month: 03 day: 01 hour: 07 minute: 40 second: 50)))) + +(test-equal "Week day" thu (week-day (date year: 2022 month: 06 day: 23))) + +(test-equal "week-1-start" (date year: 2019 month: 12 day: 30) (week-1-start (date year: 2020 month: 01 day: 01) mon)) + +;; Possibly add case where the end of the year uses next years week numbers +(test-equal "Week number at end of year" 53 (week-number (date year: 2008 month: 12 day: 31) sun)) +(test-equal "Week number at start of year" 53 (week-number (date year: 2009 month: 01 day: 01) sun)) + +(test-equal (date year: 2008 month: 12 day: 28) (date-starting-week 53 (date year: 2008) sun)) +(test-equal (date year: 2007 month: 12 day: 30) (date-starting-week 1 (date year: 2008) sun)) + +(test-group "Week day name" + (test-equal "Simple" "Saturday" (week-day-name sat locale: en_US)) + (test-equal "Truncated" "Sa" (week-day-name sat 2 locale: en_US)) + (test-equal "Other locale" "lördag" (week-day-name sat locale: sv_SE)) + (test-equal "Other locale, truncated" "lö" (week-day-name sat 2 locale: sv_SE))) + +;; TODO timespans can be both date, times, and datetimes +;; Check those cases? +(test-group "Overlapping timespans" + ;; A B C D E ¬F + ;; |s1| : |s2| : |s1| : |s2| : : |s1| + ;; | | : | | : | ||s2| : |s1|| | : |s1||s2| : | | + ;; | ||s2| : |s1|| | : | || | : | || | : | || | : + ;; | | : | | : | || | : | || | : | || | : |s2| + ;; | | : | | : | | : | | : : | | + (test-assert "End of S1 overlaps start of S2" + (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) + (time hour: 11 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00))) + (test-assert "Start of S1 overlaps end of S2" + (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00) + (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00))) + (test-assert "S1 complete encompasses S2" + (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00) + (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00))) + (test-assert "S2 complete encompasses S1" + (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) + (time hour: 10 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00))) + (test-assert "S1 is equal to S2" + (timespan-overlaps? (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) + (time hour: 11 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00))) + (test-assert "S1 dosesn't overlap S2" + (not + (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 11 minute: 00 second: 00) + (time hour: 12 minute: 00 second: 00) (time hour: 13 minute: 00 second: 00)))) + (test-assert "If the events only share an instant they don't overlap" + (not + (timespan-overlaps? (time hour: 10 minute: 00 second: 00) (time hour: 12 minute: 00 second: 00) + (time hour: 12 minute: 00 second: 00) (time hour: 14 minute: 00 second: 00))))) + +(test-equal (date year: 2022 month: 06 day: 25) (find-first-week-day sat (date year: 2022 month: 06 day: 23))) + +(test-group "All weekdays in <>" + (test-equal "month, if starting from beginning of month" + (list (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24)) + (all-wday-in-month fri (date year: 2022 month: 06 day: 01))) + + (test-equal "month, if starting from the middle" + (list (date year: 2022 month: 06 day: 24)) + (all-wday-in-month fri (date year: 2022 month: 06 day: 23))) + + (test-equal "year, if starting from the beggining" + (list (date year: 2022 month: 01 day: 07) (date year: 2022 month: 01 day: 14) (date year: 2022 month: 01 day: 21) (date year: 2022 month: 01 day: 28) (date year: 2022 month: 02 day: 04) (date year: 2022 month: 02 day: 11) (date year: 2022 month: 02 day: 18) (date year: 2022 month: 02 day: 25) (date year: 2022 month: 03 day: 04) (date year: 2022 month: 03 day: 11) (date year: 2022 month: 03 day: 18) (date year: 2022 month: 03 day: 25) (date year: 2022 month: 04 day: 01) (date year: 2022 month: 04 day: 08) (date year: 2022 month: 04 day: 15) (date year: 2022 month: 04 day: 22) (date year: 2022 month: 04 day: 29) (date year: 2022 month: 05 day: 06) (date year: 2022 month: 05 day: 13) (date year: 2022 month: 05 day: 20) (date year: 2022 month: 05 day: 27) (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24) (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 08) (date year: 2022 month: 07 day: 15) (date year: 2022 month: 07 day: 22) (date year: 2022 month: 07 day: 29) (date year: 2022 month: 08 day: 05) (date year: 2022 month: 08 day: 12) (date year: 2022 month: 08 day: 19) (date year: 2022 month: 08 day: 26) (date year: 2022 month: 09 day: 02) (date year: 2022 month: 09 day: 09) (date year: 2022 month: 09 day: 16) (date year: 2022 month: 09 day: 23) (date year: 2022 month: 09 day: 30) (date year: 2022 month: 10 day: 07) (date year: 2022 month: 10 day: 14) (date year: 2022 month: 10 day: 21) (date year: 2022 month: 10 day: 28) (date year: 2022 month: 11 day: 04) (date year: 2022 month: 11 day: 11) (date year: 2022 month: 11 day: 18) (date year: 2022 month: 11 day: 25) (date year: 2022 month: 12 day: 02) (date year: 2022 month: 12 day: 09) (date year: 2022 month: 12 day: 16) (date year: 2022 month: 12 day: 23) (date year: 2022 month: 12 day: 30)) + (all-wday-in-year fri (date year: 2022 month: 01 day: 01))) + + (test-equal "year, if starting from the middle" + (list (date year: 2022 month: 06 day: 03) (date year: 2022 month: 06 day: 10) (date year: 2022 month: 06 day: 17) (date year: 2022 month: 06 day: 24) (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 08) (date year: 2022 month: 07 day: 15) (date year: 2022 month: 07 day: 22) (date year: 2022 month: 07 day: 29) (date year: 2022 month: 08 day: 05) (date year: 2022 month: 08 day: 12) (date year: 2022 month: 08 day: 19) (date year: 2022 month: 08 day: 26) (date year: 2022 month: 09 day: 02) (date year: 2022 month: 09 day: 09) (date year: 2022 month: 09 day: 16) (date year: 2022 month: 09 day: 23) (date year: 2022 month: 09 day: 30) (date year: 2022 month: 10 day: 07) (date year: 2022 month: 10 day: 14) (date year: 2022 month: 10 day: 21) (date year: 2022 month: 10 day: 28) (date year: 2022 month: 11 day: 04) (date year: 2022 month: 11 day: 11) (date year: 2022 month: 11 day: 18) (date year: 2022 month: 11 day: 25) (date year: 2022 month: 12 day: 02) (date year: 2022 month: 12 day: 09) (date year: 2022 month: 12 day: 16) (date year: 2022 month: 12 day: 23) (date year: 2022 month: 12 day: 30)) + (all-wday-in-year fri (date year: 2022 month: 06 day: 01)))) + +;; TODO +in-date-range? + +(test-equal "weekday-list" (list wed thu fri sat sun mon tue) (weekday-list wed)) +(test-equal "start of week" (date year: 2022 month: 06 day: 20) (start-of-week (date year: 2022 month: 06 day: 23) mon)) +(test-equal "end of week" (date year: 2022 month: 06 day: 26) (end-of-week (date year: 2022 month: 06 day: 23) mon)) + + +(test-group "month-days" + (call-with-values (lambda () (month-days (date year: 2022 month: 06 day: 01) mon)) + (lambda (before actual after) + (test-equal "before" (list (date year: 2022 month: 05 day: 30) (date year: 2022 month: 05 day: 31)) before) + (test-equal "actual" (stream->list 30 (day-stream (date year: 2022 month: 06 day: 01))) actual) + (test-equal "after" (list (date year: 2022 month: 07 day: 01) (date year: 2022 month: 07 day: 02) (date year: 2022 month: 07 day: 03)) after)))) + +(test-group "Days in interval" + (test-equal "Steps from start to end of month" 31 (days-in-interval (date year: 2022 month: 01 day: 01) (date year: 2022 month: 01 day: 31))) + (test-error "Negative intervals should fail" 'misc-error (days-in-interval (date year: 2022 month: 01 day: 01) (date year: 2020 month: 01 day: 31)))) + +(test-equal "Year day" 191 (year-day (date year: 2020 month: 07 day: 09))) + +(test-group "Convertions to decimal time" + (test-group "Time->decimal-hour" + (test-equal "Exact number of hours is whole number" 5.0 (time->decimal-hour (time hour: 5))) + (test-equal "Minutes are \"base\" 60" 5.5 (time->decimal-hour (time hour: 5 minute: 30))) + (test-equal "60 Minutes gives a whole hour" 6.0 (time->decimal-hour (time hour: 5 minute: 60))) + (test-equal "A second is the right length" (/ 1.0 3600) (time->decimal-hour (time second: 1)))) + + (test-group "Datetime->decimal-hour" + (test-equal "Datetimes without dates work as times" + 5.5 (datetime->decimal-hour (datetime hour: 5 minute: 30))) + (test-equal "Full day" 24.0 (datetime->decimal-hour (datetime day: 1))) + (test-error "Can't get length of month without information about which month" + 'misc-error (datetime->decimal-hour (datetime month: 1))) + (test-equal "Can get length of month if we have a month" + (* 31 24.0) (datetime->decimal-hour (datetime month: 1) (date year: 2020 month: 01 day: 01))))) + +;; TODO +date-range + +(test-group "To string" + (test-group "Datetime->string" + (test-equal "A letter becomes itself" + "H" (datetime->string (datetime) "H")) + (test-group "Single rules" + (test-equal "~" (datetime->string (datetime) "~~")) + (test-equal "01" (datetime->string (datetime hour: 1) "~H")) + (test-equal " 1" (datetime->string (datetime hour: 1) "~k")) + (test-equal "02" (datetime->string (datetime minute: 2) "~M")) + (test-equal "03" (datetime->string (datetime second: 3) "~S")) + (test-equal "0002" (datetime->string (datetime year: 2) "~Y")) + (test-equal "02" (datetime->string (datetime month: 2) "~m")) + (test-equal "04" (datetime->string (datetime day: 4) "~d")) + (test-equal " 4" (datetime->string (datetime day: 4) "~e")) + (test-equal "1600000000" (datetime->string (datetime year: 2020 month: 09 day: 13 hour: 12 minute: 26 second: 40 tz: "UTC") "~s")) + + (test-equal "2022-10-20" (datetime->string (datetime date: (date year: 2022 month: 10 day: 20)) "~1")) + (test-equal "10:20:30" (datetime->string (datetime time: (time hour: 10 minute: 20 second: 30)) "~3")) + + (test-group "Locale dependant (en_US)" + (test-equal "Saturday" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~A" en_US)) + (test-equal "Sat" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~a" en_US)) + (test-equal "January" (datetime->string (datetime date: (date month: 1)) "~B" en_US)) + (test-equal "Jan" (datetime->string (datetime date: (date month: 1)) "~b" en_US))) + + (test-group "Locale dependant (sv_SE)" + (test-equal "lördag" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~A" sv_SE)) + (test-equal "lör" (datetime->string (datetime date: (find-first-week-day sat (date year: 2020 month: 01 day: 01))) "~a" sv_SE)) + (test-equal "januari" (datetime->string (datetime date: (date month: 1)) "~B" sv_SE)) + (test-equal "jan" (datetime->string (datetime date: (date month: 1)) "~b" sv_SE))) + + (test-group "Timezone" + (test-equal "Z" (datetime->string (datetime tz: "UTC") "~Z")) + (test-equal "" (datetime->string (datetime tz: #f) "~Z")) + (test-equal "" (datetime->string (datetime tz: "Anything else") "~Z")))) + + + (test-equal "Default fomat specifier gives ISO-formatted date" + "2006-01-02T15:04:05" (datetime->string (datetime year: 2006 month: 01 day: 02 hour: 15 minute: 04 second: 05))) + + (test-group "Invalid specifiers" + (test-equal "" (datetime->string (datetime) "~x" allow-unknown?: #t)) + (test-error 'misc-error (datetime->string (datetime) "~x"))) + + (test-group "Print syntax for datatypes" + (test-equal "Date writer" "#2020-01-02" (with-output-to-string (lambda () (write (date year: 2020 month: 01 day: 02))))) + (test-equal "Time writer" "#20:30:40" (with-output-to-string (lambda () (write (time hour: 20 minute: 30 second: 40))))) + (test-equal "Datetime writer" "#2020-01-02T20:30:40" (with-output-to-string (lambda () (write (datetime year: 2020 month: 01 day: 02 hour: 20 minute: 30 second: 40))))) + (test-equal "Datetime writer (with tz)" "#2020-01-02T20:30:40Z" (with-output-to-string (lambda () (write (datetime year: 2020 month: 01 day: 02 hour: 20 minute: 30 second: 40 tz: "UTC"))))))) + + ;; Really basic tests, since these are rather thin wrappers + (test-equal "date->string" "0000-00-00" (date->string (date))) + (test-equal "time->string" "00:00:00" (time->string (time)))) + +(test-group "Equals" + ;; date=?, time=?, and datetime=? are alias to their non-question-mark + ;; alternatives. Using them interchangably below. + (test-group "date" + (test-assert "Zero dates are all equal" + (date=)) + (test-assert "A single date is equal to itself" + (date=? (date year: 2020 month: 10 day: 20))) + (test-assert "Two dates are equal to each other" + (date= (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 20))) + (test-assert "Two dates which are NOT equal to each other" + (not (date= (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 21)))) + (test-assert "More than two dates which are all equal" + (date=? (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 20) (date year: 2020 month: 10 day: 20)))) + + (test-group "time" + (test-assert "Zero times are all equal" + (time=)) + (test-assert "A single time is equal to itself" + (time=? (time hour: 20 minute: 30 second: 40))) + (test-assert "Two times are equal to each other" + (time= (time hour: 20 minute: 30 second: 40) (time hour: 20 minute: 30 second: 40))) + (test-assert "Two times which are NOT equal to each other" + (not (time= (time hour: 20 minute: 30 second: 40) (time hour: 10 minute: 30 second: 40)))) + (test-assert "More than two times which are all equal" + (time=? (time hour: 20 minute: 30 second: 40) (time hour: 20 minute: 30 second: 40) (time hour: 20 minute: 30 second: 40)))) + + (test-group "Datetime" + (test-assert "Zero datetimes \"all\" are equal" + (datetime=)) + (test-assert "A single datetime is equal to itself" + (datetime= (datetime))) + (test-assert "Two equal datetimes are equal" + (datetime= (datetime hour: 1) (datetime hour: 1))) + (test-assert "Two dissimmalar datetimes aren't equal" + (not (datetime= (datetime hour: 1) (datetime hour: 2)))) + + ;; NOTE timezone interactions are non-existant + (test-assert "Two datetimes are equal, regardless of timezone" + (datetime= (datetime) (datetime tz: "Something Else"))) + + (test-assert "Three equal datetimes are equal" + (datetime= (datetime hour: 1) (datetime hour: 1) (datetime hour: 1))))) + +(test-group "Comparisons" + (test-group "Zero arguments" + (test-group "Dates" + (test-assert "zero dates are greater" (date<)) + (test-assert "zero dates are less" (date>))) + (test-group "Times" + (test-assert "zero times are greater" (time<)) + (test-assert "zero times are less" (time>))) + (test-group "Datetimes" + (test-assert "zero datetimes are greater" (datetime<)) + (test-assert "zero datetimes are less" (datetime>)))) + + (test-group "Single argument" + (test-group "Dates" + (test-assert "one date are greater" (date< (date))) + (test-assert "one date are less" (date> (date)))) + (test-group "Times" + (test-assert "one time are greater" (time< (time))) + (test-assert "one time are less" (time> (time)))) + (test-group "Datetimes" + (test-assert "one datetime are greater" (datetime< (datetime))) + (test-assert "one datetime are less" (datetime> (datetime))))) + + + (test-group "Two arguments" + (test-group "Dates" + (test-assert "positive comparison" (date< (date day: 1) (date day: 2))) + (test-assert "negative comparison" (not (date> (date day: 1) (date day: 2))))) + (test-group "Times" + (test-assert "positive comparison" (time< (time hour: 1) (time hour: 2))) + (test-assert "negative comparison" (not (time> (time hour: 1) (time hour: 2))))) + (test-group "Datetimes" + (test-assert "positive comparison" (datetime< (datetime day: 1) (datetime day: 2))) + (test-assert "negative comparison" (not (datetime> (datetime day: 1) (datetime day: 2)))))) + + (test-group "Two arguments" + (test-group "Dates" + (test-assert "positive comparison" + (date< (date day: 1) (date day: 2) (date day: 3))) + (test-assert "negative comparison" + (not (date< (date day: 1) (date day: 2) (date day: 1))))) + (test-group "Times" + (test-assert "positive comparison" + (time< (time hour: 1) (time hour: 2) (time hour: 3))) + (test-assert "negative comparison" + (not (date< (date day: 1) (date day: 2) (date day: 1))))) + (test-group "Datetimes" + (test-assert "positive comparison" + (datetime< (datetime day: 1) (datetime day: 2) (datetime day: 3))) + (test-assert "negative comparison" + (not (datetime< (datetime day: 1) (datetime day: 2) (datetime day: 1))))))) + +;; TODO +date<= +time<= +datetime<= + +;; TODO +date/-time< date/-time<? date/-time<= date/-time<=? +date/-time> date/-time>? date/-time>= date/-time>=? + +(test-group "Arithmetic" + (test-group "Date" + (test-group "Unary application" + (test-equal "Date+ single argument returns itself" (date) (date+ (date))) + (test-equal "Date- single argument returns itself" (date) (date- (date)))) + + (test-group "Simple cases" + (test-group "Days" + (test-equal "Add" (date year: 2020 month: 01 day: 06) (date+ (date year: 2020 month: 01 day: 01) (date day: 5))) + (test-equal "Remove" (date year: 2020 month: 01 day: 01) (date- (date year: 2020 month: 01 day: 06) (date day: 5)))) + (test-group "Months" + (test-equal "Add" (date year: 2020 month: 06 day: 01) (date+ (date year: 2020 month: 01 day: 01) (date month: 5))) + (test-equal "Remove" (date year: 2020 month: 01 day: 01) (date- (date year: 2020 month: 06 day: 01) (date month: 5)))) + (test-group "Years" + (test-equal "Add" (date year: 2022 month: 01 day: 01) (date+ (date year: 2020 month: 01 day: 01) (date year: 2))) + (test-equal "Remove" (date year: 2020 month: 01 day: 01) (date- (date year: 2022 month: 01 day: 01) (date year: 2))))) + + (test-group "Many operands" + (test-equal (date year: 2021 month: 02 day: 02) + (date+ (date year: 2020 month: 01 day: 01) + (date day: 1) + (date month: 1) + (date year: 1)))) + + (test-group "Overflow" + ;; Years don't overflow, so no need to test + (test-equal "Day overflow" (date year: 2022 month: 02 day: 01) (date+ (date year: 2022 month: 01 day: 31) (date day: 1))) + (test-equal "Month overflow" (date year: 2023 month: 01 day: 01) (date+ (date year: 2022 month: 12 day: 01) (date month: 1))) + (test-equal "Date+Month overflow" (date year: 2023 month: 01 day: 01) (date+ (date year: 2022 month: 12 day: 31) (date day: 1)))) + + ;; NOTE + (test-equal (date year: 2020 month: 02 day: 31) (date+ (date year: 2020 month: 01 day: 31) (date month: 1))) + ) + + (test-group "Time" + (test-group "Unary application" + (test-equal "Time+ single argument returns itself" (time) (time+ (time))) + (test-equal "Time- single argument returns itself" (time) (time- (time)))) + + (test-group "Simple cases" + (test-group "Seconds" + (test-equal "Add" (time hour: 20 minute: 00 second: 40) (time+ (time hour: 20 minute: 00 second: 00) (time second: 40))) + (test-equal "Remove" (time hour: 20 minute: 00 second: 00) (time- (time hour: 20 minute: 00 second: 40) (time second: 40)))) + (test-group "Minutes" + (test-equal "Add" (time hour: 20 minute: 10 second: 00) (time+ (time hour: 20 minute: 00 second: 00) (time minute: 10))) + (test-equal "Remove" (time hour: 20 minute: 00 second: 00) (time- (time hour: 20 minute: 10 second: 00) (time minute: 10)))) + (test-group "Hours" + (test-equal "Add" (time hour: 22 minute: 00 second: 00) (time+ (time hour: 20 minute: 00 second: 00) (time hour: 2))) + (test-equal "Remove" (time hour: 20 minute: 00 second: 00) (time- (time hour: 22 minute: 00 second: 00) (time hour: 2))))) + + (test-group "Overflowing cases" + (test-group "Addition" + (test-group "Single overflow" + (call-with-values (lambda () (time+ (time hour: 20 minute: 00 second: 00) (time hour: 5))) + (lambda (result overflow) + (test-equal "Time" (time hour: 1) result) + (test-equal "Overflow" 1 overflow)))) + (test-group "Mulitple overflows" + (call-with-values (lambda () (time+ (time hour: 20 minute: 00 second: 00) (time hour: 5) (time hour: 24))) + (lambda (result overflow) + (test-equal "Time" (time hour: 1) result) + (test-equal "Overflow" 2 overflow))))) + + (test-group "Subtraction" + (test-group "Single overflow" + (call-with-values (lambda () (time- (time hour: 20 minute: 00 second: 00) (time hour: 25))) + (lambda (result overflow) + (test-equal "Time" (time hour: 19) result) + (test-equal "Overflow" 1 overflow)))) + (test-group "Mulitple overflows" + (call-with-values (lambda () (time- (time hour: 4) (time hour: 10) (time hour: 24))) + (lambda (result overflow) + (test-equal "Time" (time hour: 18) result) + (test-equal "Overflow" 2 overflow)))))))) + +;; TODO +datetime+ datetime- + +(test-group "Date difference" + (test-assert "The differente between a date and itself is zero" + (date-zero? (date-difference (date year: 2022 month: 02 day: 02) (date year: 2022 month: 02 day: 02)))) + + (test-error "Later date must be first" 'misc-error + (date-difference (date year: 2020 month: 01 day: 01) (date year: 2021 month: 01 day: 01))) + + (test-error "Negative months are invalid" 'misc-error + (date-difference (date) (date month: -1))) + (test-error "Negative days are invalid" 'misc-error + (date-difference (date) (date day: -1))) + (test-equal "Negative years ARE valid" + (date year: 1) (date-difference (date) (date year: -1)))) + +;; TODO +datetime-difference + +'((datetime)) diff --git a/tests/unit/datetime/timespec.scm b/tests/unit/datetime/timespec.scm new file mode 100644 index 00000000..76fdd572 --- /dev/null +++ b/tests/unit/datetime/timespec.scm @@ -0,0 +1,98 @@ +(define-module (test timespec) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (datetime) + :use-module (datetime timespec)) + +(test-equal "The empty string parses to the empty timespec" + (timespec-zero) (parse-time-spec "")) + +(test-group "timespec-add" + + (test-equal "Zero operands gives 0" + (timespec-zero) (timespec-add)) + + (let ((ts (make-timespec (time hour: 10 minute: 20 second: 30) '- #\z))) + (test-equal "Single operand gives that operand" + ts (timespec-add ts))) + + (test-equal "0 + 0 = 0" + (timespec-zero) (timespec-add (timespec-zero) (timespec-zero))) + + (test-group + "+ -" + (test-equal "Remove a number less than the base" + (make-timespec (time hour: 10 minute: 00 second: 00) '+ #\w) + (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) + '+ #\w) + (make-timespec (time minute: 20 second: 30) + '- #\w))) + + (test-equal "Remove a number greater than the base" + (make-timespec (time hour: 01 minute: 00 second: 00) '- #\w) + (timespec-add (make-timespec (time hour: 10 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 11 minute: 00 second: 00) '- #\w))) + + (test-equal "x + -x = 0" + (timespec-zero) (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w) + (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w)))) + + (test-group "- +" + (test-equal "Add a number less than the (negative) base" + (make-timespec (time hour: 10 minute: 00 second: 00) '+ #\w) + (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w) + (make-timespec (time hour: 00 minute: 20 second: 30) '+ #\w))) + + (test-equal "Add a number greater than the (negative) base" + (make-timespec (time hour: 01 minute: 00 second: 00) '- #\w) + (timespec-add (make-timespec (time hour: 10 minute: 00 second: 00) '- #\w) + (make-timespec (time hour: 11 minute: 00 second: 00) '+ #\w))) + + (test-equal "-x + x = 0" + (timespec-zero) (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w) + (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w)))) + + (test-group "+ +" + (test-equal "x + x = 2x" + (make-timespec (time hour: 20 minute: 41 second: 00) '+ #\w) + (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w) + (make-timespec (time hour: 10 minute: 20 second: 30) '+ #\w)))) + + (test-group "- -" + (test-equal "-x + -x = -2x" + (make-timespec (time hour: 20 minute: 41 second: 00) '- #\w) + (timespec-add (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w) + (make-timespec (time hour: 10 minute: 20 second: 30) '- #\w)))) + + ;; add more than two timespecs + + ;; add timespecs of differing types + ) + +(test-group "parse-time-spec" + ;; TODO what even is this case? + (test-equal (make-timespec (time) '+ #\g) (parse-time-spec "-g")) + + (test-equal "Parse direct date, with hour minute and second" + (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\w) + (parse-time-spec "20:00:00")) + (test-equal "Parse direct date, with hour and minute" + (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\w) + (parse-time-spec "20:00")) + (test-equal "Parse direct date, with just hour" + (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\w) + (parse-time-spec "20")) + + (test-equal "Parse timespec with letter at end" + (make-timespec (time hour: 20 minute: 00 second: 00) '+ #\g) + (parse-time-spec "20:00g")) + + (test-equal "Parse negative timespec" + (make-timespec (time hour: 20 minute: 00 second: 00) '- #\w) + (parse-time-spec "-20")) + + (test-equal "Parse negative timespec with letter at end" + (make-timespec (time hour: 20 minute: 00 second: 00) '- #\z) + (parse-time-spec "-20z"))) + +'((datetime timespec)) diff --git a/tests/unit/datetime/tz.scm b/tests/unit/datetime/tz.scm new file mode 100644 index 00000000..d335ced3 --- /dev/null +++ b/tests/unit/datetime/tz.scm @@ -0,0 +1,88 @@ +;;; Commentary: +;; Tests that datetime->unix-time correctly converts between Olssen +;; timezone definitions (e.g. Europe/Stockholm), into correct times +;; and offsets (in unix time). +;; Also indirectly tests the Zone Info Compiler (datetime zic), since +;; the zoneinfo comes from there. +;;; Code: + +(define-module (test tz) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((datetime) + :select (parse-ics-datetime + datetime + date + time + datetime->unix-time + unix-time->datetime + get-datetime)) + :use-module ((hnh util env) :select (let-env))) + +;; London alternates between +0000 and +0100 +(let-env + ((TZ "Europe/London")) + (test-equal + "London winter" + (datetime year: 2020 month: 01 day: 12 hour: 13 minute: 30 second: 00) + (get-datetime + (parse-ics-datetime "20200112T133000Z"))) + (test-equal + "London summer" + (datetime year: 2020 month: 06 day: 12 hour: 14 minute: 30 second: 00) + (get-datetime + (parse-ics-datetime "20200612T133000Z")))) + +;; Stockholm alternates between +0100 and +0200 +(let-env + ((TZ "Europe/Stockholm")) + (test-equal + "Stockholm winter" + (datetime year: 2020 month: 01 day: 12 hour: 14 minute: 30 second: 00) + (get-datetime + (parse-ics-datetime "20200112T133000Z"))) + (test-equal + "Stockholm summer" + (datetime year: 2020 month: 06 day: 12 hour: 15 minute: 30 second: 00) + (get-datetime + (parse-ics-datetime "20200612T133000Z")))) + +(test-equal + -10800 + (datetime->unix-time + (parse-ics-datetime + "19700101T000000" + "Europe/Tallinn"))) + +(test-equal + -3600 + (datetime->unix-time + (parse-ics-datetime + "19700101T000000" + "Europe/Stockholm"))) + +(test-equal + 0 + (datetime->unix-time + (parse-ics-datetime "19700101T000000Z"))) + +;; yes, really +(test-equal + -3600 + (datetime->unix-time + (parse-ics-datetime + "19700101T000000" + "Europe/London"))) + +(test-equal + (datetime + date: + (date year: 1970 month: 01 day: 01) + time: + (time hour: 00 minute: 00 second: 00) + tz: + "UTC") + (unix-time->datetime 0)) + + +'((datetime)) diff --git a/tests/unit/datetime/zic.scm b/tests/unit/datetime/zic.scm new file mode 100644 index 00000000..19af169c --- /dev/null +++ b/tests/unit/datetime/zic.scm @@ -0,0 +1,319 @@ +(define-module (test zic) + :use-module ((srfi srfi-1) :select (every)) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (datetime) + :use-module (datetime timespec) + :use-module (datetime zic)) + + +(test-expect-fail "Simple Leap") +(test-expect-fail "Simple Expire") + +(define big-sample + "# Rule NAME FROM TO - IN ON AT SAVE LETTER/S +Rule Swiss 1941 1942 - May Mon>=1 1:00 1:00 S +Rule Swiss 1941 1942 - Oct Mon>=1 2:00 0 - +Rule EU 1977 1980 - Apr Sun>=1 1:00u 1:00 S +Rule EU 1977 only - Sep lastSun 1:00u 0 - +Rule EU 1978 only - Oct 1 1:00u 0 - +Rule EU 1979 1995 - Sep lastSun 1:00u 0 - +Rule EU 1981 max - Mar lastSun 1:00u 1:00 S +Rule EU 1996 max - Oct lastSun 1:00u 0 - + +# Zone NAME STDOFF RULES FORMAT [UNTIL] +Zone Europe/Zurich 0:34:08 - LMT 1853 Jul 16 + 0:29:45.50 - BMT 1894 Jun + 1:00 Swiss CE%sT 1981 + 1:00 EU CE%sT + +Link Europe/Zurich Europe/Vaduz +") + +(define parse-zic-file (@@ (datetime zic) parse-zic-file)) + +;; Some of the tests are slightly altered to score better on the coverage +(test-group "From zic(8)" + (test-equal "Basic Rule" + (list ((@@ (datetime zic) make-rule) + 'US 1967 1973 4 '(last 0) + ((@ (datetime zic) make-timespec) (time hour: 02 minute: 00 second: 00) '+ #\w) + ((@ (datetime zic) make-timespec) (time hour: 01 minute: 00 second: 00) '+ #\d) + "D")) + (call-with-input-string "Rule US 1967 1973 - Apr lastSun 2:00w 1:00d D" + parse-zic-file)) + + ;; Technically not from zic(8), since that example has an until field + (test-equal "Basic Zone" + (list ((@@ (datetime zic) make-zone) "Asia/Amman" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w) + 'Jordan "EE%sT" #f)))) + + (call-with-input-string + "Zone Asia/Amman 2:00 Jordan EE%sT" + parse-zic-file)) + + ;; Modified from the following example + (test-equal "Basic Zone with continuation" + (list ((@@ (datetime zic) make-zone) "America/Menominee" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 05 minute: 00 second: 00) '- #\w) + #f "EST" (datetime year: 1973 month: 04 day: 29 hour: 02 minute: 00 second: 00)) + ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 06 minute: 00 second: 00) '- #\w) + 'US "C%sT" #f)))) + ;; Why can't I single read a zone with an until field? + (call-with-input-string + "Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00 + -6:00 US C%sT" + parse-zic-file)) + + + (test-equal "Rules and Zone" + (list ((@@ (datetime zic) make-zone) "America/Menominee" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 05 minute: 00 second: 00) '- #\w) + #f "EST" (datetime year: 1973 month: 04 day: 29 hour: 02 minute: 00 second: 00)) + ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 06 minute: 00 second: 00) '- #\w) + 'US "C%sT" #f))) + ((@@ (datetime zic) make-rule) + 'US 1967 1973 dec '(last 0) + (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + "D") + ((@@ (datetime zic) make-rule) + 'US 1967 2006 nov '(last 0) + (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "S")) + (call-with-input-string + "# Rule NAME FROM TO - IN ON AT SAVE LETTER/S +Rule US 1967 2006 - Nov lastSun 2:00 0 S +Rule US 1967 1973 - Dec lastSun 2:00 1:00 D +# Zone NAME STDOFF RULES FORMAT [UNTIL] +Zone America/Menominee -5:00 - EST 1973 Apr 29 2:00 + -6:00 US C%sT +" parse-zic-file)) + + + (test-equal "Simple Link" + (list ((@@ (datetime zic) make-link) "Asia/Istanbul" "Europe/Istanbul")) + (call-with-input-string "Link Europe/Istanbul Asia/Istanbul" + parse-zic-file)) + + (test-equal "Simple Leap" + 'not-yet-implemented + (call-with-input-string "Leap 2016 Dec 31 23:59:60 + S" + parse-zic-file)) + + (test-equal "Simple Expire" + 'not-yet-implemented + (call-with-input-string "Expires 2020 Dec 28 00:00:00" + parse-zic-file)) + + + (test-equal "Extended example" + ;; Items are in reverse order of discovery + (list ((@@ (datetime zic) make-link) "Europe/Vaduz" "Europe/Zurich") + ((@@ (datetime zic) make-zone) "Europe/Zurich" + (list ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 00 minute: 34 second: 08) '+ #\w) + #f "LMT" (datetime year: 1853 month: 07 day: 16 hour: 00 minute: 00 second: 00)) + ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 00 minute: 29 second: 45) '+ #\w) ; NOTE that the .50 is discarded + #f "BMT" (datetime year: 1894 month: 06 day: 01 hour: 00 minute: 00 second: 00)) + ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + 'Swiss "CE%sT" (datetime year: 1981 month: 01 day: 01 hour: 00 minute: 00 second: 00)) + ((@@ (datetime zic) make-zone-entry) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + 'EU "CE%sT" #f))) + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 '(last 0) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1981 'maximum 3 '(last 0) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + "S") + ((@@ (datetime zic) make-rule) 'EU 1979 1995 9 `(last ,sun) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1978 'only 10 1 + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1977 'only 9 `(last ,sun) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'EU 1977 1980 4 `(> ,sun 1) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + "S") + ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 10 `(> ,mon 1) + (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "") + ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 5 `(> ,mon 1) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + "S")) + (call-with-input-string big-sample + parse-zic-file))) + +(test-group "rule->dtstart" + (test-equal "last sunday" + (datetime year: 1967 month: 04 day: 30 hour: 02 minute: 00 second: 00) + (rule->dtstart + ((@@ (datetime zic) make-rule) + 'US 1967 1973 4 '(last 0) + ((@ (datetime zic) make-timespec) (time hour: 02 minute: 00 second: 00) '+ #\w) + ((@ (datetime zic) make-timespec) (time hour: 01 minute: 00 second: 00) '+ #\d) + "D"))) + + (test-equal "sunday >= 1" + (datetime year: 1977 month: 04 day: 03 hour: 01 minute: 00 second: 00 tz: "UTC") + (rule->dtstart + ((@@ (datetime zic) make-rule) 'EU 1977 1980 4 `(> ,sun 1) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + "S"))) + + ;; Max and min uses dummy dates, which is slightly wrong + ;; but shouldn't cause any real problems + + (test-equal "Minimum time" + (datetime year: 0000 month: 10 day: 30 hour: 01 minute: 00 second: 00 tz: "UTC") + (rule->dtstart + ((@@ (datetime zic) make-rule) 'EU 'minimum 2000 10 '(last 0) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + + (test-equal "Maximum time" + (datetime year: 9999 month: oct day: 27 + hour: 1 tz: "UTC") + (rule->dtstart + ((@@ (datetime zic) make-rule) 'EU 'maximum 2000 10 '(last 0) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "")))) + +(test-group "zone-format" + + (test-equal "Zone format with argument" "CEST" (zone-format "CE%sT" "S")) + (test-equal "Zone format with empty" "CET" (zone-format "CE%sT" "")) + + ;; TODO zone-format %z is not yet implemented, and therefore untested + + ;; TODO this error message is currently translatable... + (test-equal "Invalid format specifier" + '(misc-error "zone-format" "Invalid format char ~s in ~s at position ~a" (#\S "%S" 1) #f) + (catch 'misc-error (lambda () (zone-format "%S" "A")) + list))) + +(test-group "Actual object" + ;; NOTE this doesn't test read-zoneinfos ability to + ;; - take filenames + ;; - take multiple items + (let ((zoneinfo (call-with-input-string big-sample (compose read-zoneinfo list)))) + (test-assert "get-zone returns a zone-entry object" + (every zone-entry? (get-zone zoneinfo "Europe/Zurich"))) + (test-equal "A link resolves to the same object as its target" + (get-zone zoneinfo "Europe/Zurich") (get-zone zoneinfo "Europe/Vaduz")) + (test-equal "Get rules returns correctly, and in order" + ;; Rules are sorted + (list ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 5 `(> ,mon 1) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\w) + "S") + ((@@ (datetime zic) make-rule) 'Swiss 1941 1942 10 `(> ,mon 1) + (make-timespec (time hour: 02 minute: 00 second: 00) '+ #\w) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "")) + (get-rule zoneinfo 'Swiss)))) + + +(test-group "rule->rrule" + (test-equal "Basic example, and to = maximum" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + byday: (list (cons -1 sun)) + bymonth: (list oct)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 '(last 0) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + "") + )) + + (test-equal "with to = only" + #f + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'only 10 '(last 2) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + + (test-equal "with definitive to year" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + byday: (list (cons -1 tue)) + bymonth: (list oct) + until: (datetime year: 2000 month: 01 day: 01 hour: 00 minute: 00 second: 00)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 2000 10 '(last 2) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + + (test-equal "on being a month day" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + bymonthday: (list 2) + bymonth: (list oct)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 2 + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + + (test-equal "on being first day after date" + ((@ (vcomponent recurrence internal) make-recur-rule) + freq: 'YEARLY interval: 1 wkst: mon + byday: (list (cons 1 mon)) + bymonth: (list oct)) + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 `(> ,mon 2) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + + (test-equal "Crash on counting backwards from date" + '(misc-error "rule->rrule" "Counting backward for RRULES unsupported" #f #f) + (catch 'misc-error + (lambda () + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'maximum 10 `(< ,mon 2) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + list)) + + (test-equal "Crash on to = minimum" + '(misc-error "rule->rrule" "Check your input" #f #f) + (catch 'misc-error + (lambda () + (rule->rrule + ((@@ (datetime zic) make-rule) 'EU 1996 'minimum 10 `(< ,mon 2) + (make-timespec (time hour: 01 minute: 00 second: 00) '+ #\u) + (make-timespec (time hour: 00 minute: 00 second: 00) '+ #\w) + ""))) + list)) + ) + +'((datetime zic)) diff --git a/tests/unit/termios/termios.scm b/tests/unit/termios/termios.scm new file mode 100644 index 00000000..3e472d81 --- /dev/null +++ b/tests/unit/termios/termios.scm @@ -0,0 +1,49 @@ +;;; 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)) + + +'((vulgar termios)) diff --git a/tests/unit/util/base64.scm b/tests/unit/util/base64.scm new file mode 100644 index 00000000..7fac883c --- /dev/null +++ b/tests/unit/util/base64.scm @@ -0,0 +1,45 @@ +;;; 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-64 test-error) + :use-module (srfi srfi-88) + :use-module (base64)) + +(test-group "Tests from RFC 4648" + (test-group "Decoding tests" + (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-group "Encoding tests" + (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")))) + + +;; Other tests + +(test-error "Invalid base64" + 'decoding-error + (base64decode "@@@@")) + +(test-error "To short base64" + 'decoding-error + (base64decode "=")) + +(test-equal "AAECAw==" (bytevector->base64-string #vu8(0 1 2 3))) + +(test-equal #vu8(0 1 2 3) (base64-string->bytevector "AAECAw==")) + +'((base64)) diff --git a/tests/unit/util/crypto.scm b/tests/unit/util/crypto.scm new file mode 100644 index 00000000..7be301a0 --- /dev/null +++ b/tests/unit/util/crypto.scm @@ -0,0 +1,24 @@ +(define-module (test crypto) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module ((crypto) :select (sha256 checksum->string))) + +(test-equal "sha256" + #vu8(24 95 141 179 34 113 254 37 245 97 166 252 147 139 46 38 67 6 236 48 78 218 81 128 7 209 118 72 38 56 25 105) + (sha256 "Hello")) + +(test-equal "sha256 string digest" + "185f8db32271fe25f561a6fc938b2e264306ec304eda518007d1764826381969" + (checksum->string (sha256 "Hello"))) + +(let ((port (open-output-string))) + (checksum->string (sha256 "Hello") port) + (test-equal "sha256 string digest to port" + "185f8db32271fe25f561a6fc938b2e264306ec304eda518007d1764826381969" + (get-output-string port))) + +(test-error 'wrong-type-arg + (sha256 'something-which-is-not-a-string-or-bytevector)) + +'((crypto)) diff --git a/tests/unit/util/hnh-util-env.scm b/tests/unit/util/hnh-util-env.scm new file mode 100644 index 00000000..74ab3b79 --- /dev/null +++ b/tests/unit/util/hnh-util-env.scm @@ -0,0 +1,49 @@ +(define-module (test hnh-util-env) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module ((guile) :select (setenv getenv)) + :use-module ((hnh util env) :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")) + + +(test-group "Unsetting environment" + (setenv "TEST" "A") + (let-env ((TEST #f)) + (test-assert (not (getenv "TEST")))) + (test-equal "A" (getenv "TEST"))) + +'((hnh util env)) diff --git a/tests/unit/util/hnh-util-lens.scm b/tests/unit/util/hnh-util-lens.scm new file mode 100644 index 00000000..0f4af6cb --- /dev/null +++ b/tests/unit/util/hnh-util-lens.scm @@ -0,0 +1,61 @@ +(define-module (test hnh-util-lens) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module (hnh util lens)) + + +(define first (ref 0)) + +(test-equal '((1)) (first '(((1))))) +(test-equal '((2)) (set '(((1))) (compose-lenses first first) 2)) +(test-equal '(((2))) (set '(((1))) (compose-lenses first first first) 2)) + + +;; (list-change (iota 10) 5 'Hello) +;; => (0 1 2 3 4 Hello 6 7 8 9) + +(test-equal '(1 (10) 3) (set '(1 (2) 3) (compose-lenses (ref 1) (ref 0)) 10)) +(test-equal '(1 (10) 3) (set '(1 (2) 3) (ref 1) (ref 0) 10)) + +;; (set (list (iota 10)) first first 11) + +(define cadr* (compose-lenses cdr* car*)) + +(test-group "Primitive lenses get and set" + (define lst '(1 2 3 4 5)) + (test-equal 1 (car* lst)) + (test-equal '(2 3 4 5) (cdr* lst)) + + (test-equal '(10 2 3 4 5) + (car* lst 10))) + +(test-group "Primitive lens composition" + (define lst '(1 2 3 4 5)) + (test-equal 2 (cadr* lst)) + (test-equal '(1 10 3 4 5) (cadr* lst 10))) + +(test-group "Modify" + (define lst '(1 2 3 4 5)) + (test-equal '(10 2 3 4 5) (modify lst car* * 10)) + (test-equal '(1 20 3 4 5) (modify lst cadr* * 10)) + ) + +(test-group "Modify*" + (define lst '(1 2 3 4 5)) + (test-equal '(1 2 4 4 5) (modify* lst cdr* cdr* car* 1+))) + +;; modify +;; modify* +;; set +;; get + +;; identity-lens +;; compose-lenses +;; lens-compose + +;; ref car* cdr* + +;; each + +'((hnh util lens)) diff --git a/tests/unit/util/hnh-util-path.scm b/tests/unit/util/hnh-util-path.scm new file mode 100644 index 00000000..e5f65505 --- /dev/null +++ b/tests/unit/util/hnh-util-path.scm @@ -0,0 +1,126 @@ +(define-module (test hnh-util-path) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module ((hnh util env) :select (with-working-directory)) + :use-module (hnh util path)) + +(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")) + +(test-assert (file-hidden? ".just-filename")) +(test-assert (file-hidden? "/path/to/.hidden")) +(test-assert (not (file-hidden? "/visible/.in/hidden"))) +(test-assert (not (file-hidden? ""))) + +;; TODO test realpath with .. and similar + +(test-equal "Realpath for path fragment" + "/home/hugo" + (with-working-directory + "/home" + (lambda () (realpath "hugo")))) + +(test-equal "Realpath for already absolute path" + "/home/hugo" + (with-working-directory + "/tmp" + (lambda () (realpath "/home/hugo")))) + +(test-equal "Realpath for already absolute path" + "/home/hugo" + (with-working-directory + "/tmp" + (lambda () (realpath "/home/hugo")))) + + +(test-group "Relative to" + + (test-group "With relative child" + (test-equal "/some/path" (relative-to "/some" "path"))) + + ;; Relative parent just adds (getcwd) to start of parent, + ;; but this is "hard" to test. + ;; (test-group "With relative parent") + + (test-group "With absolute child" + (test-error 'misc-error (relative-to "" "/some/path")) + (test-equal "some/path" (relative-to "/" "/some/path")) + (test-group "Without trailing slashes" + (test-equal "path" (relative-to "/some" "/some/path")) + (test-equal "../path" (relative-to "/some" "/other/path"))) + (test-group "With trailing slashes" + (test-equal "path" (relative-to "/some" "/some/path/")) + (test-equal "../path" (relative-to "/some" "/other/path/")))) + + (test-equal "/a/b" (relative-to "/a/b/c" "/a/b")) + + ) + + +(test-equal "Extension of simple file" + "txt" (filename-extension "file.txt")) + +(test-equal "Extension of file with directory" + "txt" (filename-extension "/direcotry/file.txt")) + +(test-equal "Extension of file with multiple" + "gz" (filename-extension "filename.tar.gz")) + +(test-equal "Filename extension when none is present" + "" (filename-extension "filename")) + +(test-equal "Filename extension when none is present, but directory has" + "" (filename-extension "config.d/filename")) + +(test-equal "Filename extension of directory" + "d" (filename-extension "config.d/")) + + +(test-equal "Extension of hidden file" + "sh" (filename-extension ".bashrc.sh")) + +(test-equal "Extension of hidden file without extension" + "bashrc" (filename-extension ".bashrc")) + +'((hnh util path)) diff --git a/tests/unit/util/hnh-util-state-monad.scm b/tests/unit/util/hnh-util-state-monad.scm new file mode 100644 index 00000000..4180a53f --- /dev/null +++ b/tests/unit/util/hnh-util-state-monad.scm @@ -0,0 +1,121 @@ +(define-module (test hnh-util-state-monad) + :use-module (srfi srfi-64) + :use-module (hnh util state-monad)) + + +(call-with-values (lambda () ((return 1) 2)) + (lambda (value state) + (test-equal "Return returns the value unmodified" 1 value) + (test-equal "Return also returns the state as a second value" 2 state))) + +(test-equal "Get returns the current state as primary value, while kepping the state" + '(state state) + (call-with-values (lambda () ((get) 'state)) list)) + +;; Return value of put untested, since it's undefined +(test-equal "Put replaces the old state with a new one, and return old one" + '(old-state new-state) + (call-with-values (lambda () ((put 'new-state) 'old-state)) + list)) + +(test-equal "A simple do is effectively a `values' call" + '(value initial-state) + (call-with-values (lambda () ((do (return 'value)) 'initial-state)) + list)) + +(test-equal "Let statement in do" + '(10 state) + (call-with-values (lambda () ((do x = 10 + (return x)) + 'state)) + list)) + +;; TODO let statement with multiple binds +;; (do let (a b) = (values 10 20) ...) + +(test-equal "Set and get through do, along with <- in do." + '(5 1) + (call-with-values (lambda () ((do old <- (get) + (put (1+ old)) + (return 5)) + 0)) + list)) + + + +(test-equal "<$> Updates stuff before being removed from the monad context" + '(11 10) + (call-with-values (lambda () + ((do x <- (<$> 1+ (get)) + (return x)) + 10)) + list)) + +(test-equal "Sequence should update the state accordingly" + 3 + (call-with-values + (lambda () + ((sequence + (list (mod 1+) + (mod 1+) + (mod 1+))) + 0)) + (lambda (_ st) st))) + +(test-equal "Sequence should also act as map on the primary value" + '((0 1 2) 3) + (call-with-values + (lambda () + ((sequence + (list (mod 1+) + (mod 1+) + (mod 1+))) + 0)) + list)) + +(test-equal "Get returns a single value when only a single value is in the state" + '(1 1) (call-with-values (lambda () ((get) 1)) + list)) + +(test-equal "Get returns a list of values when multiple items are in the state" + '((1 2 3) 1 2 3) + (call-with-values (lambda () ((get) 1 2 3)) + list)) + +(test-equal "Get with multiple values" + '((1 2) 1 2) + (call-with-values (lambda () ((get) 1 2)) + list)) + +(test-equal "Get with multiple values in do" + '((1 2) 1 2) + (call-with-values (lambda () + ((do (a b) <- (get) + (return (list a b))) + 1 2)) + list)) + +((do (put 0) + (with-temp-state + (list 10) + (do a <- (get) + (return (test-equal "Temporary state is set" + 10 a)) + (put 20))) + a <- (get) + (return (test-equal "Pre-temp state is restored" 0 a))) + 'init) + + +;; TODO test for do where the number of implicit arguments changes + +(test-equal "Something" 30 + ((do (with-temp-state + '(10 20) + ;; todo (lift +) + (do (a b) <- (get) + (return (+ a b))))) + 0 1)) + + +'((hnh util state-monad)) diff --git a/tests/unit/util/hnh-util.scm b/tests/unit/util/hnh-util.scm new file mode 100644 index 00000000..8586b6d9 --- /dev/null +++ b/tests/unit/util/hnh-util.scm @@ -0,0 +1,428 @@ +;;; Commentary: +;; Checks some prodecuders from (hnh util) +;;; Code: + +(define-module (test hnh-util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module (srfi srfi-1) + :use-module (hnh util) + ) + +(define (unreachable) + (throw 'unreachable)) + + +;;; Changed core bindings + +(test-group "set!" + (let ((x 10)) + (set! x 20) + (test-eqv "Regular set! still works" 20 x)) + + (test-group "Multiple set! at once works" + (let ((x 10) (y 20)) + (set! x 20 + y 30) + (test-eqv x 20) + (test-eqv y 30))) + + (test-group "Set! is ordered" + (let ((x 10)) + (set! x 20 + x (* x 2)) + (test-eqv x 40))) + + ;; TODO + ;; (test-group "set! =" + ;; ) + + ) + +;;; Nonscensical to test +;; (test-group "define-syntax" +;; ) + +(test-group "when" + (test-equal "when" + 1 (when #t 1)) + + (test-equal "'() when #f" + '() (when #f 1))) + +(test-group "unless" + (test-equal "unless" + 1 (unless #f 1)) + + (test-equal "'() unless #t" + '() (unless #t 1))) + + + +;;; New bindings + +(test-group "aif" + (aif (+ 1 2) + (test-eqv 3 it) + (unreachable)) + + (aif #f + (unreachable) + (test-assert #t))) + +(test-group "awhen" + (test-equal "awhen it" + '(3 4 5) + (awhen (memv 2 '(1 2 3 4 5)) + (cdr it))) + + (test-equal "awhen not" + '() + (awhen (memv 0 '(1 2 3 4 5)) + (cdr it)))) + +(test-group "for" + (test-equal "for simple" + (iota 10) + (for x in (iota 10) + x)) + + (test-equal "for matching" + (iota 12) + (for (x c) in (zip (iota 12) (string->list "Hello, World")) + x)) + + (test-equal "for with improper list elements" + `(3 7) + (for (a . b) in '((1 . 2) (3 . 4)) + (+ a b))) + + (test-equal "for with longer improper list elements" + '(1 2 4) + (for (a b . c) in '((1 -1 . 1) (2 -2 . 2) (4 -4 . 4)) + (* c (+ 1 a b))))) + +(test-group "begin1" + (let ((value #f)) + (test-equal + "begin1 return value" + "Hello" + (begin1 "Hello" (set! value "World"))) + (test-equal "begin1 side effects" "World" value)) + + (let ((x 1)) + (test-eqv "begin1 set! after return" + 1 (begin1 x (set! x 10))) + (test-eqv "Updates value" + 10 x))) + +(test-group "print-and-return" + (let ((p (open-output-string))) + (let ((v (with-error-to-port p + (lambda () (print-and-return (+ 1 2)))))) + (test-equal "Printed value" + "3 [(+ 1 2)]\n" (get-output-string p)) + (test-eqv "Returned value" + 3 v)))) + +(test-group "swap" + (test-equal + '(3 2 1) + ((swap list) 1 2 3))) + +(test-group "set/r!" + (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)"))) + +(test-group "label" + (test-equal "procedure label" + 120 + ((label factorial (lambda (n) + (if (zero? n) + 1 (* n (factorial (1- n)))))) + 5))) + +(test-group "sort*" + ;; we can't test if sort*! destroys the list, since its only /allowed/ to do it, + ;; not required. + (test-equal "sort*!" + '("a" "Hello" "Assparagus") + (sort*! '("Hello" "a" "Assparagus") + < string-length))) + + +(test-group "find-extreme" + (test-error 'wrong-type-arg (find-extreme '())) + + (test-group "find-min" + (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))))) + + (test-group "find-max" + (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-group "filter-sorted" + (test-equal + "Filter sorted" + '(3 4 5) + (filter-sorted (lambda (x) (<= 3 x 5)) (iota 10)))) + + +(test-group "!=" + (test-assert "not equal" + (!= 1 2))) + +(test-group "init+last" + 'TODO) + +(test-group "take-to" + (test-equal "Take to" + '() (take-to '() 5))) + +(test-group "string-take-to" + (test-equal "Hello" + (string-take-to "Hello, World!" 5))) + +(test-group "string-first" + (test-eqv #\H (string-first "Hello, World!"))) + +(test-group "string-last" + (test-eqv #\! (string-last "Hello, World!"))) + +(test-group "as-symb" + (test-eq "From string" 'hello (as-symb "hello")) + (test-eq "From symbol" 'hello (as-symb 'hello)) + (test-eq "NOTE that others pass right through" + '() (as-symb '()))) + + +(test-group "enumerate" + (test-equal "Enumerate" + '((0 #\H) (1 #\e) (2 #\l) (3 #\l) (4 #\o) (5 #\,) (6 #\space) (7 #\W) (8 #\o) (9 #\r) (10 #\l) (11 #\d) (12 #\!)) + (enumerate (string->list "Hello, World!")))) + + +(test-group "unval" + (test-equal "unval first" + 1 + ((unval (lambda () (values 1 2 3))))) + + (test-equal "unval other" + 2 + ((unval car+cdr 1) + (cons 1 2)))) + + +(test-group "flatten" + (test-equal "flatten already flat" + (iota 10) + (flatten (iota 10))) + + (test-equal "flatten really deep" + '(1) + (flatten '(((((((((((((((1))))))))))))))))) + + (test-equal "flatten mixed" + '(1 2 3 4 5) + (flatten '((((((1(((((2((((3))))))4))))))))5)))) + +(test-group "let-lazy" + 'TODO) + +(test-group "map/dotted" + (test-equal "map/dotted without dot" + '(1 2 3 4) + (map/dotted 1+ '(0 1 2 3))) + + (test-equal "map/dotted with dot" + '(1 2 3 . 4) + (map/dotted 1+ '(0 1 2 . 3))) + + (test-equal "map/dotted direct value" + 1 (map/dotted 1+ 0))) + +(test-group "assq-merge" + (test-equal "assq merge" + '((k 2 1) (v 2)) + (assq-merge '((k 1) (v 2)) '((k 2))))) + + +(test-group "kvlist->assq" + (test-equal "kvlist->assq" + '((a . 1) (b . 2)) + (kvlist->assq '(a: 1 b: 2))) + + (test-equal "kvlist->assq repeated key" + '((a . 1) (b . 2) (a . 3)) + (kvlist->assq '(a: 1 b: 2 a: 3)))) + +(test-group "assq-limit" + 'TODO) + + +(test-group "group-by" + ;; Extra roundabout tests since groups-by doesn't guarantee order of the keys + (test-group "Two simple groups" + (let ((groups (group-by even? (iota 10)))) + (test-assert (lset= eq? '(#f #t) (map car groups))) + (test-assert (lset= = '(0 2 4 6 8) (assq-ref groups #t))) + (test-assert (lset= = '(1 3 5 7 9) (assq-ref groups #f))))) + + (test-group "Identity groups" + (let ((groups (group-by identity (iota 5)))) + (test-assert "Correct keys" + (lset= = (iota 5) (map car groups))) + (test-group "Correct amount in each group" + (for-each (lambda (g) (test-equal 1 (length (cdr g)))) groups)))) + + (test-equal "Null case" + '() + (group-by (lambda _ (unreachable)) '()))) + +(test-group "split-by" + 'TODO) + + +(test-group "span-upto" + (test-group "Case 1" + (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)))) + + (test-group "Case 2" + (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))))) + +(test-group "cross-product" + (test-equal "Basic case" + '((1 4) + (1 5) + (1 6) + (2 4) + (2 5) + (2 6) + (3 4) + (3 5) + (3 6)) + (cross-product + '(1 2 3) + '(4 5 6))) + + (test-equal "Single input list" + '((1) (2) (3)) + (cross-product '(1 2 3))) + + (test-equal "More than two" + '((1 3 5) (1 3 6) + (1 4 5) (1 4 6) + (2 3 5) (2 3 6) + (2 4 5) (2 4 6)) + (cross-product + '(1 2) + '(3 4) + '(5 6)))) + +(test-group "string-flatten" + 'TODO) + +(test-group "intersperse" + 'TODO) + +(test-group "insert-ordered" + 'TODO) + +(test-group "-> (arrows)" + (test-equal "->" 9 (-> 1 (+ 2) (* 3))) + (test-equal "-> order dependant" -1 (-> 1 (- 2))) + (test-equal "->> order dependant" 1 (->> 1 (- 2)))) + +(test-group "set" + 'TODO) + +(test-group "set->" + 'TODO) + +(test-group "and=>" + 'TODO) + +(test-group "downcase-symbol" + 'TODO) + + +(test-group "group" + ;; TODO test failure when grouping isn't possible? + (test-equal "Group" + '((0 1) (2 3) (4 5) (6 7) (8 9)) + (group (iota 10) 2))) + +(test-group "iterate" + (test-equal 0 (iterate 1- zero? 10))) + +(test-group "valued-map" + 'TODO) + +(test-group "assoc-ref-all" + (test-equal "assoc-ref-all" + '(1 3) (assoc-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) + (test-equal "assq-ref-all" + '(1 3) (assq-ref-all '((a . 1) (b . 2) (a . 3)) 'a)) + (test-equal "assv-ref-all" + '(1 3) (assv-ref-all '((a . 1) (b . 2) (a . 3)) 'a))) + +(test-group "unique" + 'TODO) + +(test-group "vector-last" + (test-equal "vector-last" + 1 (vector-last #(0 2 3 1)))) + +(test-group "->string" + (test-equal "5" (->string 5)) + (test-equal "5" (->string "5"))) + +(test-group "catch*" + 'TODO) + +'((hnh util)) diff --git a/tests/unit/util/object.scm b/tests/unit/util/object.scm new file mode 100644 index 00000000..4f3aeb4f --- /dev/null +++ b/tests/unit/util/object.scm @@ -0,0 +1,82 @@ +(define-module (test object) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module (hnh util object) + :use-module ((hnh util) :select (->))) + +(define-type (f) x) + +(test-group "Created procedures" + (test-assert "Constructor" (procedure? f)) + (test-assert "Predicate" (procedure? f?)) + (test-assert "Field access" (procedure? x))) + +;; (f) +;; (f x: 10) +;; (f? (f)) + +(test-equal "Accessors are getters" + 10 (x (f x: 10))) +(test-assert "Accessors update, returning a object of the original type" + (f? (x (f x: 10) 20))) +(test-equal "A get after an update returns the new value" + 20 (-> (f x: 10) + (x 20) + x)) + + +(define-type (g) x) + +(test-assert "Second type can be created" + (g x: 10)) + +(test-assert "Second type isn't first type" + (not (f? (g x: 10)))) + +(test-assert "First type isn't second type" + (not (g? (f x: 10)))) + +;; Tests that the old x gets shadowed +;; (test-equal 10 (x (f x: 10))) +;; (test-equal 10 (x (g x: 10))) + +;; field-level arguments +;; - init: +(define-type (f2) (f2-x default: 0 type: integer?)) +(test-equal 0 (f2-x (f2))) + +;; - type: + +(test-error "Giving an invalid type to the constructor throws an error" + 'wrong-type-arg (f2 f2-x: 'hello)) +(test-error "Giving an invalid type to a setter throws an error" + 'wrong-type-arg (f2-x (f2) 'hello)) +(test-equal "The error includes the name of the field, the expected type, and the given value" + '(f2-x integer? hello) + (catch 'wrong-type-arg (lambda () (f2-x (f2) 'hello)) + (lambda (err proc fmt args data) args))) + +(test-equal "Typed setter updates the value" + (f2 f2-x: 10) (f2-x (f2) 10)) + +;; type-level arguments +;; - constructor: +(define-type (f3 constructor: (lambda (make check) + (lambda* (#:key f3-x f3-y) + (check f3-x f3-y) + (make f3-x f3-y)))) + (f3-x type: integer?) + (f3-y type: string?)) + +(test-assert "Custom constructors create objcets" + (f3? (f3 f3-x: 10 f3-y: "Hello"))) + +(test-error "Bad arguments to custom constructor" + 'wrong-type-arg (f3 f3-x: 'hello f3-y: 'world)) + +;; - printer: +(define-type (f4 printer: (lambda (r p) (display "something" p)))) +(test-equal "something" (with-output-to-string (lambda () (write (f4))))) + +'((hnh util object)) diff --git a/tests/unit/util/srfi-41-util.scm b/tests/unit/util/srfi-41-util.scm new file mode 100644 index 00000000..79c607c5 --- /dev/null +++ b/tests/unit/util/srfi-41-util.scm @@ -0,0 +1,110 @@ +;;; 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) + :use-module (srfi srfi-41) + :use-module ((srfi srfi-1) :select (circular-list)) + :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)))) + + + + +(test-equal "stream insert" + '(1 4 5 7 8) + (stream->list (stream-insert < 5 (stream 1 4 7 8)))) + + +(test-equal "Filter sorted stream" + '(4 6 8) + (stream->list (filter-sorted-stream even? (stream 1 3 4 6 8 9 11)))) + +(test-equal "Filter sorted stream (which actually is unsorted)" + '(4 6 8) + (stream->list (filter-sorted-stream even? (stream 1 3 4 6 8 9 11 12)))) + +;; TODO filter-sorted-stream* + +(test-equal + "Get stream interval" + '(5 6 7 8 9) + (stream->list (get-stream-interval (lambda (x) (< 4 x)) + (lambda (x) (< x 10)) + (stream 1 2 3 4 5 6 7 8 9 10 11 12)))) + + + +(test-equal "stream find" 2 (stream-find even? (stream-from 1))) + + +(test-equal + "repeating naturals" + '(1 1 1 2 2 2 3 3 3 4) + (stream->list 10 (repeating-naturals 1 3))) + + +;; sleep will return early if a singal arrives, this just resumes sleeping until +;; the wanted time is hit. +;; Might sleep longer since sleep always returns a whole number of seconds remaining +(define (true-sleep n) + (let loop ((remaining n)) + (unless (zero? remaining) + (loop (sleep remaining))))) + +(test-skip "time limited stream") + +(let ((strm (stream-map (lambda (x) (when (zero? (modulo x 4)) (true-sleep 1)) x) (stream-from 1)))) + (let ((strm (stream-timeslice-limit strm 0.1))) + (test-equal "time limited stream" + '(1 2 3) + (stream->list strm)))) + + +(test-group "stream-split-by" + (let ((hello-chars-stream (stream-unfold + car + (const #t) + cdr + (apply circular-list + (string->list "Hello "))))) + (test-equal "Check that test list looks as expected" + (string->list "Hello Hell") + (stream->list 10 hello-chars-stream)) + (test-equal "Check that it splits correctly" + '("Hello " "Hello " "Hello ") + (stream->list + 3 + (stream-map list->string + (stream-split-by (lambda (c) (char=? c #\space)) + hello-chars-stream)))))) + +'((srfi srfi-41 util)) diff --git a/tests/unit/util/sxml-namespaced.scm b/tests/unit/util/sxml-namespaced.scm new file mode 100644 index 00000000..b2d55028 --- /dev/null +++ b/tests/unit/util/sxml-namespaced.scm @@ -0,0 +1,172 @@ +(define-module (test sxml-namespaced) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module (ice-9 match) + :use-module (sxml namespaced) + :use-module (hnh util state-monad) + ) + +;;; TODO tests with attributes + +(define (ns x) + (string->symbol (format #f "http://example.com/~a" x))) + +(define (namespaced-symbol ns symb) + (string->symbol (format #f "~a:~a" ns symb))) + + + +(test-group "XML constructor utility procedure" + (test-equal "3 args" + (make-xml-element 'tagname 'namespace 'attributes) + (xml 'namespace 'tagname 'attributes)) + + (test-equal "2 args" + (make-xml-element 'tagname 'namespace '()) + (xml 'namespace 'tagname)) + + (test-equal "1 args" + (make-xml-element 'tagname #f '()) + (xml 'tagname))) + + + +(test-group "xml->namespaced-sxml" + + (test-equal + `(*TOP* (,(xml 'tag))) + (xml->namespaced-sxml "<tag/>")) + + (test-equal + `(*TOP* (,(xml 'ns1 'tag))) + (xml->namespaced-sxml "<tag xmlns='ns1'/>")) + + (test-equal + `(*TOP* (,(xml 'ns2 'tag))) + (xml->namespaced-sxml "<x:tag xmlns='ns1' xmlns:x='ns2'/>")) + + (test-equal + `(*TOP* (,(xml 'ns2 'tag) + (,(xml 'ns1 'tag)))) + (xml->namespaced-sxml "<x:tag xmlns='ns1' xmlns:x='ns2'><tag/></x:tag>")) + + (test-equal "PI are passed directly" + `(*TOP* ,(make-pi-element 'xml "encoding=\"utf-8\" version=\"1.0\"") + (,(xml 'tag))) + (xml->namespaced-sxml "<?xml encoding=\"utf-8\" version=\"1.0\"?><tag/>")) + + (test-equal "Document with whitespace in it" + `(*TOP* ,(make-pi-element 'xml "") + (,(xml 'root) + " " + (,(xml 'a)) + )) + (xml->namespaced-sxml "<?xml?><root> <a/></root>" + trim-whitespace?: #f)) + + ;; TODO is this expected? xml->sxml discards it. + (test-equal "Whitespace before root is kept" + `(*TOP* ,(make-pi-element 'xml "") + (,(xml 'root))) + (xml->namespaced-sxml "<?xml?> <root/>"))) + + + +;;; NOTE that sxml->namespaced-sxml currently ignores any existing xmlns +;;; attributes, since xml->sxml doesn't have those. +(test-group "sxml->namespaced-sxml" + (test-equal "Simplest" + `(,(xml 'a)) (sxml->namespaced-sxml '(a) '())) + (test-equal "With *TOP*" + `(*TOP* (,(xml 'a))) (sxml->namespaced-sxml '(*TOP* (a)) '())) + (test-equal "Simplest with namespace" + `(,(xml (ns 1) 'a)) + (sxml->namespaced-sxml '(x:a) + `((x . ,(ns 1))))) + (test-equal "With pi" + `(*TOP* ,(make-pi-element 'xml "test") + (,(xml 'a))) + (sxml->namespaced-sxml + `(*TOP* + (*PI* xml "test") + (a)) + '())) + (test-error "With unknown namespace" + 'missing-namespace + (sxml->namespaced-sxml '(x:a) '()))) + + + +(test-group "namespaced-sxml->*" + + ;; /namespaces is the most "primitive" one + (test-group "/namespaces" + (test-group "Without namespaces" + (call-with-values + (lambda () + (namespaced-sxml->sxml/namespaces + `(*TOP* + (,(xml 'a))))) + (lambda (tree namespaces) + (test-equal `(*TOP* (a)) tree) + (test-equal '() namespaces)))) + + (test-group "With namespaces" + (call-with-values + (lambda () + (namespaced-sxml->sxml/namespaces + `(*TOP* + (,(xml (ns 1) 'a) + (,(xml (ns 2) 'a)) + (,(xml 'a)))))) + (lambda (tree nss) + (test-eqv 2 (length nss)) + (test-equal + `(*TOP* + (,(namespaced-symbol (assoc-ref nss (ns 1)) 'a) + (,(namespaced-symbol (assoc-ref nss (ns 2)) 'a)) + (a))) + tree)))) + + (test-group "*PI*" + (call-with-values + (lambda () + (namespaced-sxml->sxml/namespaces + `(*TOP* + ,(make-pi-element 'xml "test") + (,(xml 'a))))) + (lambda (tree namespaces) + (test-equal '() namespaces) + (test-equal `(*TOP* (*PI* xml "test") + (a)) + tree))))) + + (test-group "namespaced-sxml->sxml" + (test-equal "Without namespaces" + '(*TOP* (a (@))) + (namespaced-sxml->sxml `(*TOP* (,(xml 'a))))) + + (test-group "With namespaces" + (match (namespaced-sxml->sxml `(*TOP* (,(xml (ns 1) 'a)))) + ;; (ns 1) hard coded to work with match + (`(*TOP* (,el (@ (,key "http://example.com/1")))) + (let ((el-pair (string-split (symbol->string el) #\:)) + (key-pair (string-split (symbol->string key) #\:))) + (test-equal "a" (cadr el-pair)) + (test-equal "xmlns" (car key-pair)) + (test-equal (car el-pair) (cadr key-pair)))) + (any + (test-assert (format #f "Match failed: ~s" any) #f)))))) + +;; (namespaced-sxml->xml) +;; Literal strings + + +(test-error "Namespaces x is missing, note error" + 'parser-error + (xml->namespaced-sxml "<x:a xmlns:y=\"http://example.com/1\"><x:b/></x:a>" + ; `((x . ,(ns 1))) + )) + +'((sxml namespaced)) diff --git a/tests/unit/util/uuid.scm b/tests/unit/util/uuid.scm new file mode 100644 index 00000000..7d68e38e --- /dev/null +++ b/tests/unit/util/uuid.scm @@ -0,0 +1,13 @@ +(define-module (test uuid) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-88) + :use-module (hnh util uuid)) + + +(test-equal "UUIDv4 fixed seed" + "d19c9347-9a85-4432-a876-5fb9c0d24d2b" + (parameterize ((seed (seed->random-state 0))) + (uuid-v4))) + +'((hnh util uuid)) diff --git a/tests/unit/util/xdg-basedir.scm b/tests/unit/util/xdg-basedir.scm new file mode 100644 index 00000000..5731b581 --- /dev/null +++ b/tests/unit/util/xdg-basedir.scm @@ -0,0 +1,59 @@ +(define-module (test xdg-basedir) + :use-module (srfi srfi-64) + :use-module ((xdg basedir) :prefix xdg-) + :use-module (srfi srfi-88) + :use-module ((hnh util env) :select (let-env)) + ) + + +(let-env ((HOME "/home/user") + (XDG_DATA_HOME #f) + (XDG_CONFIG_HOME #f) + (XDG_STATE_HOME #f) + (XDG_DATA_DIRS #f) + (XDG_CONFIG_DIRS #f) + (XDG_CACHE_HOME #f) + (XDG_RUNTIME_DIR #f)) + (test-group "Defaults" + (test-equal "XDG_DATA_HOME" "/home/user/.local/share" + (xdg-data-home)) + (test-equal "XDG_CONFIG_HOME" "/home/user/.config" + (xdg-config-home)) + (test-equal "XDG_STATE_HOME" "/home/user/.local/state" + (xdg-state-home)) + (test-equal "XDG_DATA_DIRS" (xdg-data-dirs) + '("/usr/local/share" "/usr/share")) + (test-equal "XDG_CONFIG_DIRS" '("/etc/xdg") + (xdg-config-dirs)) + (test-equal "XDG_CACHE_HOME" "/home/user/.cache" + (xdg-cache-home)) + (let ((warning + (with-error-to-string + (lambda () + (test-equal "XDG_RUNTIME_DIR" + "/tmp" (xdg-runtime-dir)))))) + (test-assert "The warning actually contains something" + (< 0 (string-length warning))))) + + (test-group "Custom values" + (let-env ((XDG_DATA_HOME "/a")) + (test-equal "XDG_DATA_HOME" "/a" (xdg-data-home))) + (let-env ((XDG_CONFIG_HOME "/b")) + (test-equal "XDG_CONFIG_HOME" "/b" (xdg-config-home))) + (let-env ((XDG_STATE_HOME "/c")) + (test-equal "XDG_STATE_HOME" "/c" (xdg-state-home))) + (let-env ((XDG_DATA_DIRS "/d:/e")) + (test-equal "XDG_DATA_DIRS" '("/d" "/e") (xdg-data-dirs))) + (let-env ((XDG_CONFIG_DIRS "/f:/g")) + (test-equal "XDG_CONFIG_DIRS" '("/f" "/g") (xdg-config-dirs))) + (let-env ((XDG_CACHE_HOME "/h")) + (test-equal "XDG_CACHE_HOME" "/h" (xdg-cache-home))) + (let ((warning + (with-error-to-string + (lambda () + (let-env ((XDG_RUNTIME_DIR "/i")) + (test-equal "XDG_RUNTIME_DIR" "/i" (xdg-runtime-dir))))))) + (test-assert "No error was emitted" + (string-null? warning))))) + +'((xdg basedir)) diff --git a/tests/unit/util/xml-namespace.scm b/tests/unit/util/xml-namespace.scm new file mode 100644 index 00000000..2b6ea174 --- /dev/null +++ b/tests/unit/util/xml-namespace.scm @@ -0,0 +1,38 @@ +(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)))) + +'((sxml namespace)) diff --git a/tests/unit/vcomponent/annoying-events.scm b/tests/unit/vcomponent/annoying-events.scm new file mode 100644 index 00000000..0fa81adb --- /dev/null +++ b/tests/unit/vcomponent/annoying-events.scm @@ -0,0 +1,68 @@ +(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 datetime) :select (event-overlaps?)) + :use-module ((datetime) :select (date date+ date<)) + :use-module ((hnh util) :select (set!)) + :use-module (vcomponent create) + :use-module (vcomponent base)) + + +(define start (date year: 2021 month: 11 day: 01)) + +(define end (date+ start (date day: 8))) + +(define ev-set + (stream + (vevent ; should be part of the result + summary: "A" + dtstart: (date year: 2021 month: 10 day: 01) + dtend: (date year: 2021 month: 12 day: 01)) + (vevent ; should NOT be part of the result + summary: "B" + dtstart: (date year: 2021 month: 10 day: 10) + dtend: (date year: 2021 month: 10 day: 11)) + (vevent ; should also be part of the result + summary: "C" + dtstart: (date year: 2021 month: 11 day: 02) + dtend: (date year: 2021 month: 11 day: 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))))) + + + +'((vcomponent base) + (vcomponent datetime)) diff --git a/tests/unit/vcomponent/create.scm b/tests/unit/vcomponent/create.scm new file mode 100644 index 00000000..caf2d33c --- /dev/null +++ b/tests/unit/vcomponent/create.scm @@ -0,0 +1,69 @@ +(define-module (test create) + :use-module ((srfi srfi-1) :select (every)) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((vcomponent create) + :select (vcomponent + with-parameters + as-list)) + :use-module ((vcomponent) + :select (children properties type prop prop* param vline?))) + +;; vevent, vcalendar, vtimezone, standard, and daylight all trivial +;; and therefore not tested + +(test-group "Empty component" + (let ((ev (vcomponent 'TEST))) + (test-equal 'TEST (type ev)) + (test-equal '() (children ev)) + (test-equal '() (properties ev)))) + +(test-group "Component with properties, but no children" + (let ((ev (vcomponent 'TEST + prop: "value"))) + (test-equal '(PROP) (map car (properties ev))) + (test-equal "value" (prop ev 'PROP)))) + +(test-group "Component with children, but no properties" + (let* ((child (vcomponent 'CHILD)) + (ev (vcomponent 'TEST + (list child)))) + (test-equal '() (properties ev)) + (test-equal 1 (length (children ev))) + ; (test-eq child (car (children ev))) + )) + +(test-group "Component with both children and properties" + (let* ((child (vcomponent 'CHILD)) + (ev (vcomponent 'TEST + prop: "VALUE" + (list child)))) + (test-equal '(PROP) (map car (properties ev))) + (test-equal "VALUE" (prop ev 'PROP)) + (test-equal 1 (length (children ev))) + ; (test-eq child (car (children ev))) + )) + +(test-group "Component with no children, where last elements value is a list" + (let ((ev (vcomponent 'TEST prop: (list 1 2 3)))) + (test-equal '() (children ev)) + (test-equal '(PROP) (map car (properties ev))) + (test-equal '(1 2 3) (prop ev 'PROP)))) + +(test-group "With parameters" + (let ((ev (vcomponent 'TEST + prop: (with-parameters param: 1 2)))) + (test-equal 2 (prop ev 'PROP)) + (test-equal '(1) (param (prop* ev 'PROP) 'PARAM)))) + +(test-group "As list" + (let ((ev (vcomponent 'TEST + prop: (as-list (list 1 2 3))))) + (test-equal '(1 2 3) (prop ev 'PROP)) + (test-equal 3 (length (prop* ev 'PROP))) + (test-assert (every vline? (prop* ev 'PROP))))) + +;; (test-group "Parameters and lists" ) + + +'((vcomponent create)) diff --git a/tests/unit/vcomponent/param.scm b/tests/unit/vcomponent/param.scm new file mode 100644 index 00000000..9611fd8a --- /dev/null +++ b/tests/unit/vcomponent/param.scm @@ -0,0 +1,69 @@ +;;; 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-64 test-error) + :use-module (srfi srfi-88) + :use-module ((vcomponent base) + :select (param prop* parameters prop vline?)) + :use-module ((vcomponent formats ical parse) + :select (parse-calendar)) + :use-module ((vcomponent) :select (vcomponent properties set-properties)) + :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)) + ) + +;; TODO clean up this whole test + +;; TODO possibly change parsing + +(define v + (car + (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-group "Properties" + (let ((p (properties v))) + (test-assert (list? p)) + (test-eqv 1 (length p)) + (test-eq 'X-KEY (caar p)) + (test-assert (vline? (cadar p))))) + + + +;; TODO possibly move this. +;; Checks that a warning is properly raised for +;; unkonwn keys (without an X-prefix) +(test-error "Ensure parse-calendar warns on unknown keys" + 'warning + (call-with-input-string + "BEGIN:DUMMY +KEY:Some Text +END:DUMMY" + parse-calendar)) + +;; Similar thing happens for sxcal, but during serialization instead +(let ((component (set-properties (vcomponent type: 'DUMMY) + (cons 'KEY "Anything")))) + + (test-error + 'warning + (vcomponent->sxcal component))) + +'((vcomponent base) + (vcomponent formats xcal output)) diff --git a/tests/unit/vcomponent/recurrence-advanced.scm b/tests/unit/vcomponent/recurrence-advanced.scm new file mode 100644 index 00000000..1bd4311a --- /dev/null +++ b/tests/unit/vcomponent/recurrence-advanced.scm @@ -0,0 +1,1555 @@ +;;; 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) + :select (make-recur-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 (prop prop* extract)) + :use-module (vcomponent create) + :use-module ((datetime) + :select (parse-ics-datetime + datetime + datetime-date + time + date + jan feb mar apr may jun jul aug sep oct nov dec + mon tue wed thu fri sat sun + 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 "REC: 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 "REC: 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 "REC: Every day in January, for 3 years (alt 2)") + +(define (run-test comp) + (test-equal + (string-append "REC: " (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) + ;; TODO setting language='en causes messages to be in english, but date + ;; strings still format LC_TIME (which I have set to swedish)... + ;; TODO possibly test with other languages + (format-recurrence-rule (prop comp 'RRULE) 'sv))) + +(map run-test + (list (vevent + summary: + "Daily for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'DAILY + count: 10) + x-summary: + "dagligen, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 11 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Daily until December 24, 1997" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'DAILY + until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC")) + x-summary: + "dagligen, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 23 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every other day - forever" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'DAILY + interval: 2) + x-summary: + "varannan dag" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 10 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every 10 days, 5 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'DAILY + interval: 10 + count: 5) + x-summary: + "var tionde dag, totalt 5 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 12 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every day in January, for 3 years (alt 1)" + dtstart: + (datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + until: (datetime year: 2000 month: 01 day: 31 hour: 14 minute: 00 second: 00 tz: "UTC") + bymonth: (list jan) + byday: (list sun mon tue wed thu fri sat)) + 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 (datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 31 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every day in January, for 3 years (alt 2)" + dtstart: + (datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'DAILY + until: (datetime year: 2000 month: 01 day: 31 hour: 14 minute: 00 second: 00 tz: "UTC") + bymonth: 1) + x-summary: + "dagligen, till och med den 31 januari, 2000 kl. 14:00" + x-set: + (list (datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 31 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Weekly for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + count: 10) + x-summary: + "varje vecka, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 04 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Weekly until December 24, 1997" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC")) + x-summary: + "varje vecka, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 23 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every other week - forever" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + interval: 2 + wkst: sun) + x-summary: + "varannan vecka" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 02 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 02 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 04 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 04 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 26 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Weekly on Tuesday and Thursday for five weeks (alt 1)" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + until: (datetime year: 1997 month: 10 day: 07 hour: 00 minute: 00 second: 00 tz: "UTC") + wkst: sun + byday: (list tue thu)) + x-summary: + "varje tisdag & torsdag, till och med den 07 oktober, 1997 kl. 0:00" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Weekly on Tuesday and Thursday for five weeks (alt 2)" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + count: 10 + wkst: sun + byday: (list tue thu)) + x-summary: + "varje tisdag & torsdag, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every other week on Monday, Wednesday, and Friday until December 24, 1997, starting on Monday, September 1, 1997:" + dtstart: + (datetime year: 1997 month: 09 day: 01 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + interval: 2 + until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC") + wkst: sun + byday: (list mon wed fri)) + x-summary: + "varannan måndag, onsdag & fredag, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list (datetime year: 1997 month: 09 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 22 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every other week on Tuesday and Thursday, for 8 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + interval: 2 + count: 8 + wkst: sun + byday: (list tue thu)) + x-summary: + "varannan tisdag & torsdag, totalt 8 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 16 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monthly on the first Friday for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + count: 10 + byday: (list (cons 1 fri))) + x-summary: + "första fredagen varje månad, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 02 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 04 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 05 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monthly on the first Friday until December 24, 1997" + dtstart: + (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + until: (datetime year: 1997 month: 12 day: 24 hour: 00 minute: 00 second: 00 tz: "UTC") + byday: (list (cons 1 fri))) + x-summary: + "första fredagen varje månad, till och med den 24 december, 1997 kl. 0:00" + x-set: + (list (datetime year: 1997 month: 09 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 05 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every other month on the first and last Sunday of the month for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 07 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + interval: 2 + count: 10 + byday: (list (cons 1 sun) + (cons -1 sun))) + x-summary: + "första söndagen samt sista söndagen varannan månad, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 31 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monthly on the second-to-last Monday of the month for 6 months" + dtstart: + (datetime year: 1997 month: 09 day: 22 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + count: 6 + byday: (list (cons -2 mon))) + x-summary: + "näst sista måndagen varje månad, totalt 6 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 22 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 02 day: 16 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monthly on the third-to-the-last day of the month, forever" + dtstart: + (datetime year: 1997 month: 09 day: 28 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + bymonthday: (list -3)) + x-summary: + "den tredje sista varje månad" + x-set: + (list (datetime year: 1997 month: 09 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 02 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 04 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 07 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 08 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 09 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 10 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 11 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 12 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 02 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 04 day: 28 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monthly on the 2nd and 15th of the month for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + count: 10 + bymonthday: (list 2 15)) + x-summary: + "den andre & femtonde varje månad, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 15 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monthly on the first and last day of the month for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + count: 10 + bymonthday: (list 1 -1)) + x-summary: + "den förste & sista varje månad, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 01 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every 18 months on the 10th thru 15th of the month for 10 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 10 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + interval: 18 + count: 10 + bymonthday: (list 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 (datetime year: 1997 month: 09 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 13 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every Tuesday, every other month" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + interval: 2 + byday: (list tue)) + x-summary: + "varje tisdag varannan månad" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 12 hour: 09 minute: 00 second: 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: + (datetime year: 1997 month: 06 day: 10 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + count: 10 + bymonth: (list 6 7)) + x-summary: + "juni & juli, årligen, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 06 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 07 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 06 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 07 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 06 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 07 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 06 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 07 day: 10 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every other year on January, February, and March for 10 occurrences" + dtstart: + (datetime year: 1997 month: 03 day: 10 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + interval: 2 + count: 10 + bymonth: (list jan feb mar)) + x-summary: + "januari, februari & mars vartannat år, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 03 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 02 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 02 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 03 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 02 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 03 day: 10 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every third year on the 1st, 100th, and 200th day for 10 occurrences" + dtstart: + (datetime year: 1997 month: 01 day: 01 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + interval: 3 + count: 10 + byyearday: (list 1 100 200)) + x-summary: + "dag 1, 100 & 200 vart tredje år, totalt 10 gånger" + x-set: + (list (datetime year: 1997 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 04 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 04 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 07 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 01 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 04 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 07 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 01 day: 01 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every 20th Monday of the year, forever" + dtstart: + (datetime year: 1997 month: 05 day: 19 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + byday: (list (cons 20 mon))) + x-summary: + "tjugonde måndagen, årligen" + x-set: + (list (datetime year: 1997 month: 05 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 05 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 05 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2005 month: 05 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2008 month: 05 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2009 month: 05 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 2010 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2011 month: 05 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2012 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2013 month: 05 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 2014 month: 05 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2015 month: 05 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 2016 month: 05 day: 16 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monday of week number 20 (where the default start of the week is Monday), forever" + dtstart: + (datetime year: 1997 month: 05 day: 12 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + byweekno: (list 20) + byday: (list mon)) + x-summary: + "varje måndag v.20, årligen" + x-set: + (list (datetime year: 1997 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 05 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 05 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2005 month: 05 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2008 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2009 month: 05 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 2010 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2011 month: 05 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2012 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2013 month: 05 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2014 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2015 month: 05 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 2016 month: 05 day: 16 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every Thursday in March, forever" + dtstart: + (datetime year: 1997 month: 03 day: 13 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + bymonth: (list mar) + byday: (list thu)) + x-summary: + "varje torsdag i mars, årligen" + x-set: + (list (datetime year: 1997 month: 03 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 03 day: 20 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 03 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 03 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 03 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 03 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 03 day: 23 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 03 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 03 day: 01 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 03 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 03 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 03 day: 22 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every Thursday, but only during June, July, and August, forever" + dtstart: + (datetime year: 1997 month: 06 day: 05 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + byday: (list thu) + bymonth: (list 6 7 8)) + x-summary: + "varje torsdag i juni, juli & augusti, årligen" + x-set: + (list (datetime year: 1997 month: 06 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 06 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 06 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 06 day: 26 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 24 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 07 day: 31 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 21 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 28 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 25 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 07 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 07 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 07 day: 16 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every Friday the 13th, forever" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + exdate: + (as-list + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00))) + rrule: + (make-recur-rule + freq: 'MONTHLY + byday: (list fri) + bymonthday: (list 13)) + x-summary: + "varje fredag den trettonde varje månad" + x-set: + (list (datetime year: 1998 month: 02 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 11 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 08 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 10 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 04 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 07 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 09 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 12 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 06 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 02 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 08 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2005 month: 05 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 10 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 04 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 07 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2008 month: 06 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2009 month: 02 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2009 month: 03 day: 13 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "The first Saturday that follows the first Sunday of the month, forever" + dtstart: + (datetime year: 1997 month: 09 day: 13 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + byday: (list sat) + bymonthday: (list 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 (datetime year: 1997 month: 09 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 02 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 04 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 06 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 07 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 08 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 09 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 10 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 12 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 09 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 02 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 03 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 04 day: 10 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every 4 years, the first Tuesday after a Monday in November,\nver (U.S. Presidential Election day)" + dtstart: + (datetime year: 1996 month: 11 day: 05 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + interval: 4 + bymonth: (list nov) + byday: (list tue) + bymonthday: (list 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 (datetime year: 1996 month: 11 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 11 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 2008 month: 11 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 2012 month: 11 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 2016 month: 11 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 2020 month: 11 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 2024 month: 11 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 2028 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 2032 month: 11 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 2036 month: 11 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 2040 month: 11 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 2044 month: 11 day: 08 hour: 09 minute: 00 second: 00) + (datetime year: 2048 month: 11 day: 03 hour: 09 minute: 00 second: 00) + (datetime year: 2052 month: 11 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 2056 month: 11 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 2060 month: 11 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 2064 month: 11 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 2068 month: 11 day: 06 hour: 09 minute: 00 second: 00) + (datetime year: 2072 month: 11 day: 08 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "The third instance into the month of one of Tuesday, Wednesday, or Thursday, for the next 3 months" + dtstart: + (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + count: 3 + byday: (list tue wed thu) + bysetpos: (list 3)) + x-summary: + "NOT YET IMPLEMENTED" + x-set: + (list (datetime year: 1997 month: 09 day: 04 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 07 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 06 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "The second-to-last weekday of the month" + dtstart: + (datetime year: 1997 month: 09 day: 29 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + byday: (list mon tue wed thu fri) + bysetpos: (list -2)) + x-summary: + "NOT YET IMPLEMENTED" + x-set: + (list (datetime year: 1997 month: 09 day: 29 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 10 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 11 day: 27 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 12 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 01 day: 29 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every 3 hours from 9:00 AM to 5:00 PM on a specific day" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'HOURLY + interval: 3 + until: (datetime year: 1997 month: 09 day: 02 hour: 17 minute: 00 second: 00 tz: "UTC")) + x-summary: + "var tredje timme, till och med den 02 september, 1997 kl. 17:00" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 15 minute: 00 second: 00))) + (vevent + summary: + "Every 15 minutes for 6 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MINUTELY + interval: 15 + count: 6) + x-summary: + "varje kvart, totalt 6 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 15 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 30 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 45 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 15 second: 00))) + (vevent + summary: + "Every hour and a half for 4 occurrences" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MINUTELY + interval: 90 + count: 4) + x-summary: + "var sjätte kvart, totalt 4 gånger" + x-set: + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 30 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 30 second: 00))) + (vevent + summary: + "Every 20 minutes from 9:00 AM to 4:40 PM every day (alt 1)" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'DAILY + byhour: (list 9 10 11 12 13 14 15 16) + byminute: (list 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 (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 11 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 11 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 11 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 14 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 14 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 14 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 15 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 15 minute: 20 second: 00))) + (vevent + summary: + "Every 20 minutes from 9:00 AM to 4:40 PM every day (alt 2)" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MINUTELY + interval: 20 + byhour: (list 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 (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 10 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 11 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 11 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 11 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 12 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 13 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 14 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 14 minute: 20 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 14 minute: 40 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 15 minute: 00 second: 00) + (datetime year: 1997 month: 09 day: 02 hour: 15 minute: 20 second: 00))) + (vevent + summary: + "An example where the days generated makes a difference because of WKST" + dtstart: + (datetime year: 1997 month: 08 day: 05 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + interval: 2 + count: 4 + byday: (list tue sun) + wkst: mon) + x-summary: + "varannan tisdag & söndag, totalt 4 gånger" + x-set: + (list (datetime year: 1997 month: 08 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 24 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "changing only WKST from MO to SU, yields different results.." + dtstart: + (datetime year: 1997 month: 08 day: 05 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'WEEKLY + interval: 2 + count: 4 + byday: (list tue sun) + wkst: sun) + x-summary: + "varannan tisdag & söndag, totalt 4 gånger" + x-set: + (list (datetime year: 1997 month: 08 day: 05 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 08 day: 31 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "An example where an invalid date (i.e., February 30) is ignored" + dtstart: + (datetime year: 2007 month: 01 day: 15 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'MONTHLY + bymonthday: (list 15 30) + count: 5) + x-summary: + "den femtonde & tretionde varje månad, totalt 5 gånger" + x-set: + (list (datetime year: 2007 month: 01 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 01 day: 30 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 02 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 03 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2007 month: 03 day: 30 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Every Friday & Wednesday the 13th, forever" + dtstart: + (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00) + exdate: + (as-list + (list (datetime year: 1997 month: 09 day: 02 hour: 09 minute: 00 second: 00))) + rrule: + (make-recur-rule + freq: 'MONTHLY + byday: (list fri wed) + bymonthday: (list 13)) + x-summary: + "varje onsdag & fredag den trettonde varje månad" + x-set: + (list (datetime year: 1998 month: 02 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 03 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 11 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 01 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 08 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 10 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 09 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 10 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 12 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 04 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 06 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 07 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 02 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 03 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 09 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 11 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 12 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 06 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 08 day: 13 hour: 09 minute: 00 second: 00))) + (vevent + summary: + "Monday & Wednesday of week number 20 (where the default start of the week is Monday), forever" + dtstart: + (datetime year: 1997 month: 05 day: 12 hour: 09 minute: 00 second: 00) + rrule: + (make-recur-rule + freq: 'YEARLY + byweekno: (list 20) + byday: (list mon wed)) + x-summary: + "varje onsdag & måndag v.20, årligen" + x-set: + (list (datetime year: 1997 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 1997 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 11 hour: 09 minute: 00 second: 00) + (datetime year: 1998 month: 05 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 1999 month: 05 day: 19 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2000 month: 05 day: 17 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2001 month: 05 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 05 day: 13 hour: 09 minute: 00 second: 00) + (datetime year: 2002 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2003 month: 05 day: 14 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 05 day: 10 hour: 09 minute: 00 second: 00) + (datetime year: 2004 month: 05 day: 12 hour: 09 minute: 00 second: 00) + (datetime year: 2005 month: 05 day: 16 hour: 09 minute: 00 second: 00) + (datetime year: 2005 month: 05 day: 18 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 05 day: 15 hour: 09 minute: 00 second: 00) + (datetime year: 2006 month: 05 day: 17 hour: 09 minute: 00 second: 00))) + (vevent + summary: "Each second, for ever" + dtstart: (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 00) + rrule: (make-recur-rule freq: 'SECONDLY) + x-summary: "varje sekund" + x-set: (list (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 00) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 01) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 02) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 03) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 04) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 05) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 06) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 07) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 08) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 09) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 10) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 11) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 12) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 13) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 14) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 15) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 16) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 17) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 18) + (datetime year: 2020 month: 10 day: 10 hour: 10 minute: 00 second: 19))) + ;; Exdates are applied after rrule's, meaning that less than count + ;; instances may be present. + (vevent + summary: "Exdates are applied AFTER rrule's" + dtstart: (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00) + rrule: (make-recur-rule freq: 'DAILY count: 5) + exdate: (as-list (list (datetime year: 2022 month: 06 day: 12 hour: 10 minute: 00 second: 00))) + x-summary: "dagligen, totalt 5 gånger" + x-set: (list (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 11 hour: 10 minute: 00 second: 00) + ;; (datetime year: 2022 month: 06 day: 12 hour: 10 minute: 00 second: 00) ; skipped by exdate + (datetime year: 2022 month: 06 day: 13 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 14 hour: 10 minute: 00 second: 00) + )) + (vevent + summary: "RDATE:s add to the recurrence rule" + dtstart: (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00) + rrule: (make-recur-rule freq: 'DAILY count: 5) + rdate: (as-list (list (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00))) + x-summary: "dagligen, totalt 5 gånger" + x-set: (list (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 11 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 12 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 13 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 14 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00) ; added by rdate + ) + ) + (vevent + summary: "RDATE:s add to the recurrence rule" + dtstart: (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00) + rrule: (make-recur-rule freq: 'DAILY count: 5) + exdate: (as-list (list (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00))) + rdate: (as-list (list (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00))) + x-summary: "dagligen, totalt 5 gånger" + x-set: (list (datetime year: 2022 month: 06 day: 10 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 11 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 12 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 13 hour: 10 minute: 00 second: 00) + (datetime year: 2022 month: 06 day: 14 hour: 10 minute: 00 second: 00) + ;; (datetime year: 2022 month: 06 day: 20 hour: 10 minute: 00 second: 00) ; added by rdate, removed by exdate + )) + ;; TODO rdate with different timezone than dtstart + ;; TODO rdate with period + )) + + + +'((vcomponent recurrence) + (vcomponent recurrence generate) + (vcomponent recurrence display) + (vcomponent recurrence internal)) diff --git a/tests/unit/vcomponent/recurrence-simple.scm b/tests/unit/vcomponent/recurrence-simple.scm new file mode 100644 index 00000000..31a74989 --- /dev/null +++ b/tests/unit/vcomponent/recurrence-simple.scm @@ -0,0 +1,324 @@ +;;; 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-64 test-error) + :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 ((sxml namespaced) :select (sxml->namespaced-sxml)) + :use-module ((calp namespaces) :select (xcal)) + :use-module ((hnh util) :select (->)) + :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))) + +;; TODO evaluate format for direct events + +;;; 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 (lambda _ ""))) + (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-arg + (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 + (car + (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))))) + +(test-assert "Test 1" #t) + +(define ev + (car + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +RRULE:FREQ=DAILY +END:VEVENT" + parse-calendar))) + +(test-assert "Test 2" #t) + +(test-assert "daily 10:00" + (stream-car (generate-recurrence-set ev))) + +(define ev + (car + (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 + (car + (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 + (car + (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 + (car + (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 + (car + (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 + (car + (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 + (car + (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 + (car + (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 + (-> '(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)) + (sxml->namespaced-sxml `((#f . ,xcal))) + sxcal->vcomponent)) + +(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
+ +;; TODO add remaining rules + + +'((vcomponent recurrence) + (vcomponent formats ical parse) + (vcomponent formats xcal parse)) diff --git a/tests/unit/vcomponent/rrule-serialization.scm b/tests/unit/vcomponent/rrule-serialization.scm new file mode 100644 index 00000000..540c5bd2 --- /dev/null +++ b/tests/unit/vcomponent/rrule-serialization.scm @@ -0,0 +1,77 @@ +(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))))) + + +'((vcomponent recurrence internal) + (vcomponent recurrence parse)) diff --git a/tests/unit/vcomponent/vcomponent-control.scm b/tests/unit/vcomponent/vcomponent-control.scm new file mode 100644 index 00000000..7ebafa3d --- /dev/null +++ b/tests/unit/vcomponent/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 create) + :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 (vcomponent 'DUMMY x-key: "value")) + +(test-group "With replaced properties" + ;; 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 +(test-group "With replaced properties when throwing" + (catch #t + (lambda () + (with-replaced-properties + (ev (X-KEY "other")) + (throw 'any))) + (lambda _ (test-equal "value" (prop ev 'X-KEY))))) + +'((vcomponent util control)) diff --git a/tests/unit/vcomponent/vcomponent-datetime.scm b/tests/unit/vcomponent/vcomponent-datetime.scm new file mode 100644 index 00000000..80fee259 --- /dev/null +++ b/tests/unit/vcomponent/vcomponent-datetime.scm @@ -0,0 +1,44 @@ +;;; 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 create) :select (vevent))) + +(define ev + (vevent + dtstart: (datetime year: 2020 month: 03 day: 29 hour: 17 minute: 00 second: 00) + dtend: (datetime year: 2020 month: 04 day: 01 hour: 10 minute: 00 second: 00))) + + +;; |-----------------| test interval +;; |----------| event interval + +(test-equal + "Correct clamping" + (datetime time: (time hour: 7)) ; 2020-03-29T17:00 - 2020-03-30T00:00 + (event-length/clamped + (date year: 2020 month: 03 day: 23) ; a time way before the start of the event + (date year: 2020 month: 03 day: 29) ; a time slightly after the end of the event + ev)) + +(define utc-ev + (vevent + dtstart: (datetime year: 2020 month: 03 day: 29 hour: 15 minute: 00 second: 00 tz: "UTC") + dtend: (datetime year: 2020 month: 04 day: 01 hour: 08 minute: 00 second: 00 tz: "UTC"))) + +(test-equal + "Correct clamping UTC" + (datetime time: (time hour: 7)) + (event-length/clamped + (date year: 2020 month: 03 day: 23) + (date year: 2020 month: 03 day: 29) + ev)) + + +'((vcomponent datetime)) diff --git a/tests/unit/vcomponent/vcomponent-formats-common-types.scm b/tests/unit/vcomponent/vcomponent-formats-common-types.scm new file mode 100644 index 00000000..1d7c77cf --- /dev/null +++ b/tests/unit/vcomponent/vcomponent-formats-common-types.scm @@ -0,0 +1,140 @@ +(define-module (test vcomponent-formats-common-types) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :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 + (date year: 2021 month: 12 day: 02) + (parse-date #f "20211202")) +;; TODO negative test here + +(define parse-datetime (get-parser 'DATE-TIME)) + +(test-equal + (datetime year: 2021 month: 12 day: 02 hour: 10 minute: 20 second: 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 + (time hour: 10 minute: 20 second: 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 + +'((vcomponent formats common types)) diff --git a/tests/unit/vcomponent/vcomponent.scm b/tests/unit/vcomponent/vcomponent.scm new file mode 100644 index 00000000..ebd0b1ff --- /dev/null +++ b/tests/unit/vcomponent/vcomponent.scm @@ -0,0 +1,105 @@ +;;; Commentary: +;; Test base functionallity of vcomponent structures. +;;; Code: + +(define-module (test vcomponent) + :use-module (srfi srfi-17) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (hnh util table) + :use-module (datetime) + :use-module (vcomponent base)) + + + + +(define ev + (prop (vcomponent type: 'DUMMY) + 'X-KEY "value")) + +(test-eqv "Non-existant properties return #f" + #f (prop ev 'MISSING)) + +(test-assert "Existing property is non-false" + (prop ev 'X-KEY)) + +(test-equal "Getting value of existing property" + "value" (prop ev 'X-KEY)) + +(define calendar (add-child (vcomponent type: 'VCALENDAR) + ev)) + +(test-equal 1 (length (children calendar))) + +;;; TODO remove child +;; (abandon! calendar ev) +;; (test-equal 0 (length (children calendar))) + + + +(define vline* + (vline + key: 'DTSTART + vline-value: (date year: 2020 month: 01 day: 02) + vline-parameters: (alist->table + '((VALUE . "DATE"))) + vline-source: "DTSTART;VALUE=DATE:2020-01-02")) + +(test-group "vline" + (test-assert "Type check works as expected" + (vline? vline*))) + +(define vcomponent* + (vcomponent type: 'VEVENT)) + +(test-assert "Type check works as expected" + (vcomponent? vcomponent*)) + +(define child + (vcomponent type: 'CHILD)) + + +(test-eqv + "An added component extends length" + 1 (length (children (add-child vcomponent* child)))) + +(test-eqv + "But the source isn't modified" + 0 (length (children vcomponent*))) + +(test-equal "Setting property" + (list (list 'KEY (vline key: 'KEY vline-value: "Value"))) + (properties + (prop vcomponent* 'KEY "Value"))) + +(let ((vl (vline key: 'KEY vline-value: "Value"))) + (test-equal "Setting property vline" + (list (list 'KEY vl)) + (properties + (prop* vcomponent* 'KEY vl)))) + +(test-equal "Set properties test" + '(K1 K2) + (map car + (properties + (apply set-properties + vcomponent* + `((K1 . "V1") + (K2 . "V2")))))) + +;; remove-property + +;; extract extract* + + +;; remove-parameter +;; value +;; param + +;; parameters +;; properties + +;; x-property? +;; internal-field? + +'((vcomponent base)) diff --git a/tests/unit/web-util/server.scm b/tests/unit/web-util/server.scm new file mode 100644 index 00000000..c81abba3 --- /dev/null +++ b/tests/unit/web-util/server.scm @@ -0,0 +1,31 @@ +;;; Commentary: +;; Tests parse-endpoint-string, used for defining server routes. +;;; Code: + +(define-module (test server) + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module ((web http make-routes) + :select (parse-endpoint-string))) + +(test-assert "Check that parsing doesn't crash" + (parse-endpoint-string "/static/:dir/:file")) + +;; Checks that parsing produces correct results +(test-group + "Simple parameters" + (let ((path args (parse-endpoint-string "/static/:dir/:file"))) + (test-equal "Path" "/static/([^/.]+)/([^/.]+)" path) + (test-equal "Parameters" '(dir file) args))) + +;; Checks that parsing with custom regex works +;; along with literal periods. +(test-group + "Custom regex for parameters" + (let ((path args (parse-endpoint-string "/static/:filename{.*}.:ext"))) + (test-equal "Path" "/static/(.*)\\.([^/.]+)" path) + (test-equal "Parameters" '(filename ext) args))) + + +'((web http make-routes)) diff --git a/tests/unit/web-util/web-query.scm b/tests/unit/web-util/web-query.scm new file mode 100644 index 00000000..ec20b0c1 --- /dev/null +++ b/tests/unit/web-util/web-query.scm @@ -0,0 +1,37 @@ +(define-module (test web-query) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module ((web query) :select (parse-query))) + +(test-equal "Empty query gives empty assoc list" + '() (parse-query "")) +(test-equal "Simple key-value query" + '(key: "value") (parse-query "key=value")) + +;; Slightly cumbersome check, since keys aren't ordered +(test-group + "Simple key-value query, with multiple keys" + (let ((kv-list (parse-query "k1=value&k2=1"))) + (test-equal "value" (and=> (memv k1: kv-list) cadr)) + (test-equal "1" (and=> (memv k2: kv-list) cadr)))) + +(test-equal "Values are HTTP-decoded" + '(key: " ") (parse-query "key=%20")) +(test-equal "Keys are HTTP-decoded" + '(A: "test") (parse-query "%41=test")) + +(test-equal "Query with only key, value becomes key" + '(key: "key") (parse-query "key")) + +(test-group + "Some with only key" + (let ((kv-list (parse-query "k1&k2=10"))) + (test-equal "k1" (and=> (memv k1: kv-list) cadr)) + (test-equal "10" (and=> (memv k2: kv-list) cadr)))) + +;; I don't know if HTTP allows this, but my code works like this +(test-equal "Value with equal in it" + '(key: "=") (parse-query "key==")) + + +'((web query)) diff --git a/tests/unit/webdav/webdav-file.scm b/tests/unit/webdav/webdav-file.scm new file mode 100644 index 00000000..85f4738d --- /dev/null +++ b/tests/unit/webdav/webdav-file.scm @@ -0,0 +1,56 @@ +(define-module (test webdav-file) + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module (hnh util) + :use-module (hnh util path) + :use-module (ice-9 ftw) + :use-module (ice-9 rdelim) + :use-module (oop goops) + :use-module (calp webdav resource) + :use-module (calp webdav resource file) + ) + +;;; Commentary: +;;; Tests the specifics of the file backed webdav resource objects. +;;; Code: + + +;;; TODO general helper procedure for this +(define test-root (mkdtemp (string-copy "/tmp/calp-test-XXXXXX"))) + +(define root-resource (make <file-resource> + root: test-root)) + + +(test-group "File resource collection" + (add-collection! root-resource "subdir") + (test-eqv "Collection correctly added" + 'directory (-> (path-append test-root "subdir") + stat stat:type) )) + + + +;;; TODO this fails, sice <file-resource> doesn't override add-resource! +;;; <file-resources>'s add resource must at least update root path path of the +;;; child resource, and possibly also touch the file (so ctime gets set). +(test-group "File resource with content" + (let ((fname "file.txt") + (s "Hello, World!\n")) + (add-resource! root-resource fname s) + (let ((p (path-append test-root fname))) + (test-eqv "File correctly added" + 'regular (-> p stat stat:type)) + (test-equal "Expected content was written" + s + (with-input-from-file p + (lambda () (read-delimited ""))) + )))) + + + +(test-group "Copy file" + 'TODO) + +'((calp webdav resource) + (calp webdav resource file)) diff --git a/tests/unit/webdav/webdav-server.scm b/tests/unit/webdav/webdav-server.scm new file mode 100644 index 00000000..d5fa0e93 --- /dev/null +++ b/tests/unit/webdav/webdav-server.scm @@ -0,0 +1,353 @@ +(define-module (test webdav-server) + ;; :use-module (srfi srfi-1) + ;; :use-module (ice-9 threads) + + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module (calp server webdav) + :use-module (calp webdav resource) + :use-module ((calp webdav property) :select (propstat)) + :use-module (calp webdav resource virtual) + :use-module (calp namespaces) + :use-module (oop goops) + :use-module (web request) + :use-module (web response) + :use-module (web uri) + :use-module (sxml simple) + :use-module (sxml xpath) + :use-module (sxml namespaced) + :use-module (hnh util) + ) + +;;; Commentary: +;;; Tests that handlers for all HTTP Methods works correctly. +;;; Note that these tests don't have as goal to check that resources and +;;; properties work correctly. See (test webdav) and (test webdav-tree) for that. +;;; +;;; The namespaces http://ns.example.com/properties is intentionally given +;;; different prefixes everywhere, to ensure that namespaces are handled correctly. +;;; Code: + +(define prop-ns (string->symbol "http://ns.example.com/properties")) + +(root-resource (make <virtual-resource> name: "*root*")) +(add-resource! (root-resource) "a" "Contents of A") +(add-resource! (root-resource) "b" "Contents of B") + +;;; Connect output of one procedure to input of another +;;; Both producer and consumer should take exactly one port as argument +(define (connect producer consumer) + ;; (let ((in out (car+cdr (pipe)))) + ;; (let ((thread (begin-thread (consumer in)))) + ;; (producer out) + ;; (join-thread thread))) + + (call-with-input-string + (call-with-output-string producer) + consumer)) + +(define (xml->sxml* port) + (xml->sxml port namespaces: `((d . ,(symbol->string webdav)) + (y . ,(symbol->string prop-ns))))) + + + +(test-group "run-propfind" + (test-group "Working, depth 0" + (let* ((request (build-request + (string->uri "http://localhost/") + method: 'PROPFIND + headers: '((depth . 0)) + validate-headers?: #f)) + (head body (run-propfind '() request #f))) + (test-equal 207 (response-code head)) + (test-equal '(application/xml) + (response-content-type head)) + (test-assert (procedure? body)) + (let ((body* (connect body xml->sxml*))) + ;; Arbitrarily chosen resource + (test-equal "Resource gets returned as expected" + '((d:resourcetype (d:collection))) + ((sxpath '(// d:response + (d:propstat (// d:status (equal? "HTTP/1.1 200 OK"))) + // d:resourcetype)) + body*))))) + + (test-group "Depth: infinity" + (let* ((request (build-request + (string->uri "http://localhost/") + method: 'PROPFIND + headers: '((depth . infinity)) + validate-headers?: #f)) + (head body (run-propfind '() request #f))) + (test-equal 207 (response-code head)) + (test-equal '(application/xml) (response-content-type head)) + (test-assert (procedure? body)) + (let ((body* (connect body xml->sxml*))) + (test-equal + '("/" "/a" "/b") + (sort* ((sxpath '(// d:href *text*)) body*) + string<))))) + + (test-group "With body" + (let ((request (build-request (string->uri "http://localhost/") + method: 'PROPFIND + headers: '((depth . 0)) + validate-headers?: #f)) + (request-body "<?xml version=\"1.0\" encoding=\"utf-8\"?> +<propfind xmlns=\"DAV:\"> + <prop><resourcetype/></prop> +</propfind>")) + (let ((head body (run-propfind '() request request-body))) + (test-equal 207 (response-code head)) + (test-equal '(application/xml) (response-content-type head)) + (test-assert (procedure? body)) + (let ((body* (connect body xml->sxml*))) + (test-equal "We only get what we ask for" + '((d:prop (d:resourcetype (d:collection)))) + ((sxpath '(// d:response + (d:propstat (// d:status (equal? "HTTP/1.1 200 OK"))) + // d:prop)) + body*))))))) + + + +(test-group "run-proppatch" + (let ((request (build-request (string->uri "http://localhost/a") + method: 'PROPPATCH)) + (request-body (format #f "<?xml version=\"1.0\" encoding=\"utf-8\"?> +<propertyupdate xmlns=\"DAV:\" xmlns:x=\"~a\"> + <set> + <prop> + <displayname>New Displayname</displayname> + <x:test><x:content/></x:test> + </prop> + </set> + <!-- TODO test remove? --> +</propertyupdate>" prop-ns))) + (let ((response body (run-proppatch '("a") request request-body))) + (test-equal 207 (response-code response)) + (test-equal '(application/xml) (response-content-type response)) + (test-assert (procedure? body)) + ;; Commit the changes + (call-with-output-string body) + )) + + (let ((response body (run-propfind + '("a") + (build-request (string->uri "http://localhost/a") + method: 'PROPFIND + headers: '((depth . 0)) + validate-headers?: #f) + (format #f "<?xml version=\"1.0\" encoding=\"utf-8\"?> +<propfind xmlns=\"DAV:\" xmlns:z=\"~a\"> + <prop> + <displayname/> + <z:test/> + </prop> +</propfind>" prop-ns)))) + (test-equal 207 (response-code response)) + (test-equal '(application/xml) (response-content-type response)) + (test-assert (procedure? body)) + + ;; (format (current-error-port) "Here~%") + ;; ;; The crash is after here + ;; (body (current-error-port)) + + (let* ((body* (connect body xml->sxml*)) + (properties ((sxpath '(// d:response + (d:propstat (// d:status (equal? "HTTP/1.1 200 OK"))))) + body*))) + ;; ((@ (ice-9 format) format) (current-error-port) "Properties: ~y~%" properties) + (test-equal "Native active property is properly updated" + '("New Displayname") + ((sxpath '(// d:displayname *text*)) properties)) + (test-equal "Custom property is correctly stored and preserved" + '((y:test (y:content))) + ((sxpath '(// y:test)) properties)))) + + ;; TODO test proppatch atomicity + ) + + + +(test-group "run-options" + (let ((head body (run-options #f #f))) + (test-equal "options head" + (build-response + code: 200 + headers: `((dav . (1)) + (allow . (GET HEAD PUT MKCOL PROPFIND OPTIONS DELETE COPY MOVE)))) + head) + (test-equal "options body" + "" body))) + + + +(test-group "run-get" + (let ((head body (run-get '("a") + (build-request + (string->uri "http://localhost/a") + method: 'GET) + 'GET))) + (test-equal "Contents of A" body))) + + + +(test-group "run-put" + (test-group "Update existing resource" + (run-put '("a") + (build-request (string->uri "http://localhost/a") + method: 'PUT + port: (open-output-string)) + "New Contents of A") + + (let ((head body (run-get '("a") + (build-request + (string->uri "http://localhost/a") + method: 'GET) + 'GET))) + (test-equal "Put updates subsequent gets" + "New Contents of A" body))) + + (test-group "Create new resource" + (run-put '("c") + (build-request (string->uri "http://localhost/c") + method: 'PUT + port: (open-output-string)) + "Created Resource C") + (let ((head body (run-get '("c") + (build-request + (string->uri "http://localhost/c") + method: 'GET) + 'GET))) + (test-equal "Put creates new resources" + "Created Resource C" body)))) + + + +;;; Run DELETE +(test-group "run-delete" + 'TODO) + + + + +(test-group "run-mkcol" + (run-mkcol '("a" "b") + (build-request (string->uri "http://localhost/a/b") + method: 'MKCOL) + "") + (let* ((request (build-request + (string->uri "http://localhost/") + method: 'PROPFIND + headers: '((depth . infinity)) + validate-headers?: #f)) + (head body (run-propfind '() request #f))) + (test-equal 207 (response-code head)) + (test-equal '(application/xml) (response-content-type head)) + (test-assert (procedure? body)) + (let ((body* (connect body xml->sxml*))) + (test-equal "Check that all created resources now exists" + '("/" "/a" "/a/b" "/b" "/c") + (sort* ((sxpath '(// d:href *text*)) body*) + string<))))) + + +;;; TODO test MKCOL indempotence + + + +;;; Run COPY +(test-group "run-copy" + (parameterize ((root-resource (make <virtual-resource> name: "*root*"))) + (add-resource! (root-resource) "a" "Content of A") + (let ((a (lookup-resource (root-resource) '("a")))) + (set-property! a `(,(xml prop-ns 'test) "prop-value")) + ;; Extra child added to ensure deep copy works + (add-resource! a "d" "Content of d")) + + (test-group "cp /a /c" + (let ((response _ + (run-copy '("a") + (build-request + (string->uri "http://example.com/a") + headers: `((destination + . ,(string->uri "http://example.com/c"))))))) + ;; Created + (test-eqv "Resource was reported created" + 201 (response-code response))) + + (let ((c (lookup-resource (root-resource) '("c")))) + (test-assert "New resource present in tree" c) + (test-equal "Content was correctly copied" + "Content of A" (content c)) + (test-equal "Property was correctly copied" + (propstat 200 + (list `(,(xml prop-ns 'test) + "prop-value"))) + (get-property c (xml prop-ns 'test))))) + + (test-group "cp --no-clobber /c /a" + (let ((response _ + (run-copy '("c") + (build-request + (string->uri "http://example.com/c") + headers: `((destination + . ,(string->uri "http://example.com/a")) + (overwrite . #f)))))) + ;; collision + (test-eqv "Resource collision was reported" + 412 (response-code response)))) + + ;; Copy recursive collection, and onto child of self. + (test-group "cp -r / /c" + (let ((response _ + (run-copy '() + (build-request + (string->uri "http://example.com/") + headers: `((destination . ,(string->uri "http://example.com/c"))))))) + (test-eqv "Check that reported replaced" + 204 (response-code response)) + (test-equal "Check that recursive resources where created" + '("/" "/a" "/a/d" "/c" + ;; New resources. Note that /c/c doesn't create an infinite loop + "/c/a" "/c/a/d" "/c/c") + (map car + (sort* (map (lambda (p) (cons (href->string (car p)) (cdr p))) + (all-resources-under (root-resource) '())) + string< car))) + + ;; TODO we should also check that /c is a copy of the root resource, + ;; instead of the old /c resource. + ;; Do this by setting some properties + )))) + + + +;;; Run MOVE +(test-group "run-move" + (parameterize ((root-resource (make <virtual-resource> name: "*root*"))) + (add-resource! (root-resource) "a" "Content of A") + (let ((a (lookup-resource (root-resource) '("a")))) + (set-property! a `(,(xml prop-ns 'test) "prop-value"))) + + (test-group "mv /a /c" + (let ((response _ + (run-move '("a") + (build-request + (string->uri "http://example.com/a") + headers: `((destination + . ,(string->uri "http://example.com/c"))))))) + ;; Created + (test-eqv "Resource was reported created" + 201 (response-code response)) + ;; TODO check that old resource is gone + )))) + + + +;;; Run REPORT + +'((calp server webdav)) diff --git a/tests/unit/webdav/webdav-tree.scm b/tests/unit/webdav/webdav-tree.scm new file mode 100644 index 00000000..da6073eb --- /dev/null +++ b/tests/unit/webdav/webdav-tree.scm @@ -0,0 +1,92 @@ +(define-module (test webdav-tree) + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module (calp webdav resource) + :use-module (calp webdav resource virtual) + :use-module (calp webdav resource file) + :use-module (oop goops) + :use-module (rnrs bytevectors) + :use-module (rnrs io ports) + :use-module ((hnh util) :select (sort*)) + :use-module (hnh util path) + ) + +(define* (pretty-print-tree tree + optional: (formatter (lambda (el) (write el) (newline))) + key: (depth 0)) + (cond ((null? tree) 'noop) + ((pair? tree) + (display (make-string (* depth 2) #\space)) (formatter (car tree)) + (for-each (lambda (el) (pretty-print-tree el formatter depth: (+ depth 1))) + (cdr tree))) + (else (formatter tree)))) + +(define-method (resource-tree (self <resource>)) + (cons self + (map resource-tree (children self)))) + + + +(define dir (mkdtemp (string-copy "/tmp/webdav-tree-XXXXXX"))) +(with-output-to-file (path-append dir "greeting") + (lambda () (display "Hello, World!\n"))) + +(define root-resource (make <virtual-resource> + name: "*root*")) + +(define virtual-resource (make <virtual-resource> + name: "virtual" + content: (string->bytevector "I'm Virtual!" (native-transcoder)))) + +(define file-tree (make <file-resource> + root: dir + name: "files")) + +(mount-resource! root-resource file-tree) +(mount-resource! root-resource virtual-resource) + +(test-equal "All resources in tree, along with href items" + (list (cons '() root-resource) + (cons '("files") file-tree) + (cons '("files" "greeting") (car (children file-tree))) + (cons '("virtual") virtual-resource)) + (sort* (all-resources-under root-resource) string< (compose string-concatenate car))) + + + +;; (pretty-print-tree (resource-tree root-resource)) + + + +;; (test-equal '("") (href root-resource) ) ; / +;; ;; (test-equal '("" "virtual") (href virtual-resource)) ; /virtual & /virtual/ +;; (test-equal '("virtual") (href virtual-resource)) ; /virtual & /virtual/ +;; ;; (test-equal '("" "files") (href file-tree)) ; /files & /files/ +;; (test-equal '("files") (href file-tree)) ; /files & /files/ + +(test-eqv "Correct amount of children are mounted" + 2 (length (children root-resource))) + +(test-eq "Lookup root" + root-resource (lookup-resource root-resource '())) + +(test-eq "Lookup of mount works (virtual)" + virtual-resource (lookup-resource root-resource '("virtual"))) +(test-eq "Lookup of mount works (files)" + file-tree (lookup-resource root-resource '("files"))) + +;; (test-equal "File resource works as expected" +;; "/home/hugo/tmp" +;; (path file-tree)) + +(let ((resource (lookup-resource root-resource (string->href "/files/greeting")))) + (test-assert (resource? resource)) + (test-assert (file-resource? resource)) + ;; (test-equal "/files/greeting" (href->string (href resource))) + (test-equal "Hello, World!\n" (bytevector->string (content resource) (native-transcoder))) + ) + +'((calp webdav resource) + (calp webdav resource virtual) + (calp webdav resource file)) diff --git a/tests/unit/webdav/webdav-util.scm b/tests/unit/webdav/webdav-util.scm new file mode 100644 index 00000000..c4e16536 --- /dev/null +++ b/tests/unit/webdav/webdav-util.scm @@ -0,0 +1,31 @@ +(define-module (test webdav-util) + :use-module (srfi srfi-64) + :use-module (srfi srfi-64 test-error) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module (calp webdav resource base)) + +(test-group "string->href" + (test-equal "Root path becomes null" + '() (string->href "/")) + (test-equal "Trailing slashes are ignored" + '("a" "b") (string->href "/a/b/"))) + +(test-group "href->string" + (test-equal "Null case becomes root path" + "/" (href->string '())) + (test-equal "Trailing slashes are not added" + "/a/b" (href->string '("a" "b")))) + +(test-group "href-relative" + (test-equal '("a" "b") (href-relative '() '("a" "b"))) + (test-equal '("b") (href-relative '("a") '("a" "b"))) + (test-equal '() (href-relative '("a" "b") '("a" "b"))) + + (test-error 'misc-error + (href-relative '("c") '("a" "b"))) + + (test-error 'misc-error + (href-relative '("c") '()))) + +'((calp webdav resource base)) diff --git a/tests/unit/webdav/webdav.scm b/tests/unit/webdav/webdav.scm new file mode 100644 index 00000000..e86b5342 --- /dev/null +++ b/tests/unit/webdav/webdav.scm @@ -0,0 +1,359 @@ +(define-module (test webdav) + :use-module (srfi srfi-64) + :use-module (srfi srfi-71) + :use-module (srfi srfi-88) + :use-module (srfi srfi-1) + :use-module (sxml namespaced) + :use-module (oop goops) + :use-module (calp namespaces) + :use-module ((hnh util) :select (sort*)) + :use-module (datetime) + + :use-module (calp webdav property) + :use-module (calp webdav propfind) + :use-module (calp webdav resource) + :use-module (calp webdav resource virtual) + ) + +;;; NOTE these tests don't check that XML namespaces work correctly, but only as +;;; far as not checking that the correct namespace is choosen. They should fail if +;;; namespacing gets completely broken. + +;;; TODO tests for a missing resource? + +(define (swap p) (xcons (car p) (cdr p))) + +(define dt #2010-11-12T13:14:15) + +(define resource (make <virtual-resource> + ;; local-path: '("") + name: "*root" + content: #vu8(1 2 3 4) + creation-time: dt)) + +(define (sort-propstats propstats) + (map + (lambda (propstat) + (make-propstat (propstat-status-code propstat) + (sort* (propstat-property propstat) + string< (compose symbol->string xml-element-tagname car)) + (propstat-error propstat) + (propstat-response-description propstat))) + (sort* propstats < propstat-status-code)) + ) + +;; (test-equal "/" (href->string (href resource))) +(test-equal "Basic propstat" + (propstat 200 (list (list (xml webdav 'getcontentlength) 4))) + (getcontentlength resource)) + + +(define (sort-symbols symbs) + (sort* symbs string<=? symbol->string)) + + + +;;; NOTE propstat's return order isn't stable, making this test possibly fail +(let ((ps (list (propstat 200 (list `(,(xml webdav 'displayname) "Displayname"))) + (propstat 200 (list `(,(xml webdav 'getcontenttype) "text/plain")))))) + (test-equal "Propstat merger" + (list (propstat 200 + (list (list (xml webdav 'getcontenttype) "text/plain") + (list (xml webdav 'displayname) "Displayname")))) + (merge-propstats ps))) + + + +(test-group "All live properties" + (let ((props (live-properties resource))) + (test-assert (list? props)) + (for-each (lambda (pair) + ;; (test-assert (xml-element? (car pair))) + (test-assert (live-property? (cdr pair))) + (test-assert (procedure? (property-getter (cdr pair)))) + (test-assert (procedure? (property-setter-generator (cdr pair))))) + props))) + +(test-group "\"All\" live properties" + (let ((most (propfind-most-live-properties resource))) + (test-equal "Correct amount of keys" 10 (length most)) + (for-each (lambda (propstat) + (test-assert "Propstat is propstat" (propstat? propstat)) + (test-equal (format #f "Propstat well formed: ~a" (propstat-property propstat)) + 1 (length (propstat-property propstat))) + (test-assert "Propstat child is xml" + (xml-element? (caar (propstat-property propstat))))) + most) + + (test-equal "Correct keys" + '(creationdate displayname getcontentlanguage getcontentlength + getcontenttype getetag getlastmodified + lockdiscovery resourcetype supportedlock) + (sort-symbols (map (compose xml-element-tagname caar propstat-property) most))))) + + + +(define ns1 (string->symbol "http://example.com/namespace")) + +(set-dead-property! resource `(,(xml ns1 'test) "Content")) + +(test-equal "Get dead property" + (propstat 200 (list (list (xml ns1 'test) "Content"))) + (get-dead-property resource (xml ns1 'test))) + +(test-equal "Get live property" + (propstat 404 (list (list (xml ns1 'test)))) + (get-live-property resource (xml ns1 'test))) + +(test-group "Dead properties" + (test-equal "Existing property" + (propstat 200 (list (list (xml ns1 'test) "Content"))) + (get-property resource (xml ns1 'test))) + + (test-equal "Missing property" + (propstat 404 (list (list (xml ns1 'test2)))) + (get-property resource (xml ns1 'test2))) + + (test-equal "All dead properties" + (list (propstat 200 (list (list (xml ns1 'test) "Content")))) + (propfind-all-dead-properties resource))) + +(test-group "Live Properties" + + ;; TODO these tests were written when displayname always returned 200, but have since changed to test for 404. + ;; Change to another property which return 200 + (test-equal "Existing live property (through get-live-property)" + (propstat 404 `((,(xml webdav 'displayname)))) + (get-live-property resource (xml webdav 'displayname))) + + (test-equal "Existing live property (thrtough get-property)" + (propstat 404 `((,(xml webdav 'displayname)))) + (get-property resource (xml webdav 'displayname))) + ) + +(test-equal "propfind-selected-properties" + (list (propstat 404 `((,(xml webdav 'displayname))))) + (propfind-selected-properties resource (list (xml webdav 'displayname)))) + +(test-group "parse-propfind" + (test-group "propname" + (let ((props (parse-propfind `(,(xml webdav 'propfind) + (,(xml webdav 'propname))) + resource))) + + + (test-group "Propfind should NEVER fail for an existing resource" + (test-equal 1 (length props)) + (test-equal 200 (propstat-status-code (car props)))) + + (test-assert "Propstat objects are returned" (propstat? (car props))) + (for-each (lambda (el) + (test-assert "Base is list" (list? el)) + (test-eqv "List only contains head el" 1 (length el)) + #; + (test-assert (format #f "Head is an xml tag: ~a" el) + (xml-element? (car el)))) + (propstat-property (car props))) + + #; + (test-equal "Correct property keys" + (sort-symbols (cons* 'test 'is-virtual webdav-keys)) + (sort-symbols (map (compose xml-element-tagname car) + (propstat-property (car props))))) + + (test-group "No property should contain any data" + (for-each (lambda (el) + (test-eqv (format #f "Propname property: ~s" el) + 1 (length el))) + (propstat-property (car props)))))) + + + (test-group "direct property list" + (let ((props (parse-propfind `((xml webdav 'propfind) + (,(xml webdav 'prop) + (,(xml webdav 'displayname)))) + resource))) + (test-equal "Simple lookup" + (list (propstat 404 (list (list (xml webdav 'displayname) + )))) + props))) + + ;; TODO test that calendar properties are reported by propname + ;; TODO test that non-native caldav propreties aren't reported by allprop + + (test-group "allprop" + (let ((props (parse-propfind `(,(xml webdav 'propfind) + (,(xml webdav 'allprop))) + resource))) + + + (test-equal "Propfind result" + (list + (propstat 200 + (list (list (xml webdav 'creationdate) + (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) + (list (xml webdav 'getcontentlength) + 4) + (list (xml webdav 'getcontenttype) + "application/binary") + (list (xml webdav 'getlastmodified) + "Thu, 01 Jan 1970 00:00:00 GMT") + (list (xml webdav 'lockdiscovery) '()) + (list (xml webdav 'resourcetype) + ; (list (xml webdav 'collection)) + ) + (list (xml webdav 'supportedlock) '()) + (list (xml ns1 'test) "Content") + )) + (propstat 404 (list (list (xml webdav 'displayname)) + (list (xml webdav 'getcontentlanguage)))) + (propstat 501 + (list (list (xml webdav 'getetag)) + ))) + (sort-propstats props)))) + + + (test-group "allprop with include" + (let ((props (parse-propfind `((xml webdav 'propfind) + (,(xml webdav 'allprop)) + (,(xml webdav 'include))) + resource))) + + + (test-equal "Include NOTHING" + (list + (propstat 200 + (list (list (xml webdav 'creationdate) + (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) + (list (xml webdav 'getcontentlength) + 4) + (list (xml webdav 'getcontenttype) + "application/binary") + (list (xml webdav 'getlastmodified) + "Thu, 01 Jan 1970 00:00:00 GMT") + (list (xml webdav 'lockdiscovery) '()) + (list (xml webdav 'resourcetype) + ; (list (xml webdav 'collection)) + ) + (list (xml webdav 'supportedlock) '()) + (list (xml ns1 'test) "Content") + )) + (propstat 404 (list (list (xml webdav 'displayname)) + (list (xml webdav 'getcontentlanguage)))) + (propstat 501 + (list (list (xml webdav 'getetag)) + ))) + (sort-propstats props))) + + + (let ((props (parse-propfind `(,(xml webdav 'propfind) + (,(xml webdav 'allprop)) + (,(xml webdav 'include) + (,(xml virtual-ns 'isvirtual)))) + resource))) + + (test-equal "Include isvirtual" + (list + (propstat 200 + (list (list (xml webdav 'creationdate) (datetime->string dt "~Y-~m-~dT~H:~M:~SZ")) + (list (xml webdav 'getcontentlength) 4) + (list (xml webdav 'getcontenttype) "application/binary") + (list (xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT") + (list (xml virtual-ns 'isvirtual) "true") + (list (xml webdav 'lockdiscovery) '()) + (list (xml webdav 'resourcetype)) + (list (xml webdav 'supportedlock) '()) + (list (xml ns1 'test) "Content") + )) + (propstat 404 (list (list (xml webdav 'displayname)) + (list (xml webdav 'getcontentlanguage)))) + (propstat 501 + (list (list (xml webdav 'getetag)) + ))) + (sort-propstats props))))) + + + + +;;; Setting properties + +;;; We already use set-dead-property! above, but for testing get we need set, +;;; and for testing set we need get, and get is more independent, so we start there. + + + +(test-group "Propstat -> namespaced sxml" + (test-equal "Simple" + `(,(xml webdav 'propstat) + (,(xml webdav 'prop) (,(xml webdav 'displayname) "test")) + (,(xml webdav 'status) "HTTP/1.1 200 OK")) + (propstat->namespaced-sxml (propstat 200 `((,(xml webdav 'displayname) "test")) ))) + + ;; TODO populated error field + + (test-equal "With response description" + `(,(xml webdav 'propstat) + (,(xml webdav 'prop) (,(xml webdav 'displayname) "test")) + (,(xml webdav 'status) "HTTP/1.1 403 Forbidden") + (,(xml webdav 'responsedescription) "Try logging in")) + (propstat->namespaced-sxml (propstat 403 `((,(xml webdav 'displayname) "test")) + responsedescription: "Try logging in")))) + + + + +;;; TODO what am I doing here? + +(test-equal + (list (propstat 200 + `((,(xml webdav 'getcontentlength) 4) + (,(xml webdav 'getlastmodified) "Thu, 01 Jan 1970 00:00:00 GMT") + (,(xml webdav 'resourcetype)))) + (propstat 404 + `((,(xml webdav 'checked-in)) + (,(xml webdav 'checked-out)) + (,(xml (string->symbol "http://apache.org/dav/props/") 'executable))))) + (let ((request (xml->namespaced-sxml + "<?xml version=\"1.0\" encoding=\"utf-8\"?> +<propfind xmlns=\"DAV:\"> + <prop> + <getcontentlength/> + <getlastmodified/> + <executable xmlns=\"http://apache.org/dav/props/\"/> + <resourcetype/> + <checked-in/> + <checked-out/> + </prop> +</propfind>"))) + + (sort-propstats (parse-propfind (caddr request) resource)))) + + + +(test-group "lookup-resource" + (let* ((root (make <virtual-resource> name: "*root*")) + (a (add-collection! root "a")) + (b (add-collection! a "b")) + (c (add-resource! b "c" "~~Nothing~~"))) + (test-eq "Lookup root" + root (lookup-resource root '())) + (test-eq "Lookup direct child" + a (lookup-resource root '("a"))) + (test-eq "Lookup deep child" + c (lookup-resource root '("a" "b" "c"))) + (test-assert "Lookup missing" + (not (lookup-resource root '("a" "d" "c")))))) + + + + +(test-group "mkcol" + (let ((root (make <virtual-resource> name: "*root*"))) + (add-collection! root "child") + (test-eqv "Child got added" 1 (length (children root))))) + + +'((calp webdav property) + (calp webdav propfind) + (calp webdav resource) + (calp webdav resource virtual)) |