From f852c30bcef530d18a474ab6ab8350a3ef93d563 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 30 Jan 2020 22:51:45 +0100 Subject: Once again compiles. --- tests/entry.scm | 7 +++ tests/recurrence-rule.scm | 14 +++++ tests/recurring.scm | 137 ++++++++++++++++++++++++++++++++++++++++++---- tests/run-tests.scm | 11 +++- tests/srfi-19-alt.scm | 110 ++++++++++++++++++++++++++++++++++++- tests/time.scm | 58 -------------------- tests/vcomponent.scm | 12 ++++ 7 files changed, 278 insertions(+), 71 deletions(-) create mode 100644 tests/entry.scm create mode 100644 tests/recurrence-rule.scm delete mode 100644 tests/time.scm create mode 100644 tests/vcomponent.scm (limited to 'tests') diff --git a/tests/entry.scm b/tests/entry.scm new file mode 100644 index 00000000..dddcb99c --- /dev/null +++ b/tests/entry.scm @@ -0,0 +1,7 @@ +(((parameters) calendar-files) + ((vcomponent load) load-calendars) + ) + +(test-assert (load-calendars calendar-files: (calendar-files))) + + diff --git a/tests/recurrence-rule.scm b/tests/recurrence-rule.scm new file mode 100644 index 00000000..0edfc0a1 --- /dev/null +++ b/tests/recurrence-rule.scm @@ -0,0 +1,14 @@ +(((vcomponent recurrence parse) parse-recurrence-rule) + ((vcomponent recurrence internal) + make-recur-rule weekdays intervals)) + + +(test-equal + (make-recur-rule (freq 'DAILY) (wkst 'MO) (interval 1)) + (parse-recurrence-rule "FREQ=DAILY")) + +(test-equal + (make-recur-rule (freq 'WEEKLY) (wkst 'MO) (interval 1)) + (parse-recurrence-rule "FREQ=WEEKLY")) + +;; TODO more tests diff --git a/tests/recurring.scm b/tests/recurring.scm index b32759ba..da6e18a8 100644 --- a/tests/recurring.scm +++ b/tests/recurring.scm @@ -1,6 +1,7 @@ -(((srfi srfi-41) stream-take stream-map stream->list) - ((srfi srfi-19) date->time-utc time-utc->date) - ((srfi srfi-19 util) day-stream) +(((srfi srfi-41) stream-take stream-map stream->list stream-car) + ;; ((srfi srfi-19) date->time-utc time-utc->date) + ;; ((srfi srfi-19 util) day-stream) + ((srfi srfi-19 alt util) day-stream) ((vcomponent base) extract attr) ((vcomponent) parse-calendar) @@ -11,12 +12,15 @@ (define ev (call-with-input-string "BEGIN:VEVENT -DTSTART;20190302 +DTSTART: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" @@ -26,9 +30,8 @@ END:VEVENT" (generate-recurrence-set ev)))) (stream->list (stream-take - 5 (stream-map date->time-utc - (day-stream - (time-utc->date (attr ev 'DTSTART))))))) + 5 (day-stream + (attr ev 'DTSTART))))) ;; We run the exact same thing a secound time, since I had an error with ;; that during development. @@ -40,11 +43,125 @@ END:VEVENT" (generate-recurrence-set ev)))) (stream->list (stream-take - 5 (stream-map date->time-utc - (day-stream - (time-utc->date (attr ev 'DTSTART))))))) + 5 (day-stream + (attr ev 'DTSTART))))) + + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +RRULE:FREQ=DAILY +END:VEVENT" + parse-calendar) ) + +(test-assert "daily 10:00" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +DTEND:20190302T120000 +RRULE:FREQ=DAILY +END:VEVENT" + parse-calendar)) + +(test-assert "daily 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20190302T100000 +DTEND:20190302T120000 +RRULE:FREQ=WEEKLY +END:VEVENT" + parse-calendar)) +(test-assert "weekly 10-12" + (stream-car (generate-recurrence-set ev))) ;;; TODO, also test: ;;; - limited repetition ;;; - weird rules + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20190302T100000 +DTEND;TZID=Europe/Stockholm:20190302T120000 +RRULE:FREQ=WEEKLY +END:VEVENT" + parse-calendar)) + +(test-assert "weekly TZ 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20190302T100000 +DTEND;TZID=Europe/Stockholm:20190302T120000 +RRULE:FREQ=WEEKLY +SEQUENCE:1 +END:VEVENT" + parse-calendar)) + +(test-assert "weekly TZ SEQUENCE 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20190302T100000 +RRULE:FREQ=WEEKLY +DTEND;TZID=Europe/Stockholm:20190302T120000 +SEQUENCE:1 +LOCATION:Here +END:VEVENT" + parse-calendar)) + +(test-assert "weekly TZ SEQUENCE LOCATION 10-12" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART:20180117T170000 +RRULE:FREQ=WEEKLY +LOCATION:~ +END:VEVENT" + parse-calendar)) + +(test-assert "Just location" + (stream-car (generate-recurrence-set ev))) + + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20180117T170000 +DTEND;TZID=Europe/Stockholm:20180117T200000 +RRULE:FREQ=WEEKLY +END:VEVENT" + parse-calendar)) + +(test-assert "Same times" + (stream-car (generate-recurrence-set ev))) + +(define ev + (call-with-input-string + "BEGIN:VEVENT +DTSTART;TZID=Europe/Stockholm:20180117T170000 +RRULE:FREQ=WEEKLY +DTEND;TZID=Europe/Stockholm:20180117T200000 +SEQUENCE:1 +LOCATION:~ +END:VEVENT" + parse-calendar)) + +;; errer in dtend ? + +(test-assert "Full test" + (stream-car (generate-recurrence-set ev))) diff --git a/tests/run-tests.scm b/tests/run-tests.scm index 613b89df..4ffe6d4e 100755 --- a/tests/run-tests.scm +++ b/tests/run-tests.scm @@ -14,8 +14,9 @@ (use-modules (ice-9 ftw) (ice-9 sandbox) - (srfi srfi-64) - ((util) :select (for))) + (srfi srfi-64) ; test suite + (srfi srfi-88) ; suffix keywords + ((util) :select (for awhen))) (define files (scandir here @@ -35,10 +36,16 @@ (reverse done) (loop (cons sexp done)))))) + ;; TODO test-group fails if called before any test begin, since ;; (test-runner-current) needs to be a test-runner (dead or not), ;; but is initially bound to #f. (test-begin "tests") + +(awhen (member "--skip" (command-line)) + (for skip in (cdr it) + (test-skip skip))) + (for fname in files (format (current-error-port) "Running test ~a~%" fname) (test-group diff --git a/tests/srfi-19-alt.scm b/tests/srfi-19-alt.scm index 1fad2fa5..9e03bf53 100644 --- a/tests/srfi-19-alt.scm +++ b/tests/srfi-19-alt.scm @@ -1,5 +1,113 @@ -((srfi srfi-19 alt) date+ date- date) +(((srfi srfi-19 alt) date+ date- + year month day + date time + date< + datetime + datetime+ + datetime- + datetime<=? + ) + ((ice-9 format) format) + ) + +(test-assert "Synatx date" + #2020-01-01) + +(test-assert "Test year type" + (integer? (year (date year: 2020)))) + +(test-assert "Test month type" + (integer? (month (date month: 1)))) + +(test-assert "Test day type" + (integer? (day (date day: 1)))) + +(test-equal "Manual print (any)" + "2020-10-10" + (let ((d (date year: 2020 month: 10 day: 10))) + (format #f "~a-~a-~a" + (year d) (month d) (day d)))) + +(test-equal "Manual print (number)" + "2020-10-10" + (let ((d (date year: 2020 month: 10 day: 10))) + (format #f "~d-~d-~d" + (year d) (month d) (day d)))) + +(test-equal "Date print" + "2020-01-01" + (format #f "~a" (date year: 2020 month: 1 day: 1))) + +(test-equal "Syntax date=" + (date year: 2020 month: 1 day: 1) + #2020-01-01) + +(test-equal "Syntax time=" + (time hour: 13 minute: 37 second: 0) + #13:37:00) + +(test-equal "Syntax Datetime=" + (datetime year: 2020 month: 1 day: 1 hour: 13 minute: 37 second: 0) + #2020-01-01T13:37:00) (test-equal #2020-02-28 (date- #2020-03-05 (date day: 6))) (test-equal #2020-02-29 (date- #2020-03-05 (date day: 5))) (test-equal #2020-03-01 (date- #2020-03-05 (date day: 4))) + +(test-equal "date+ day" #2020-10-10 (date+ #2020-10-01 (date day: 9))) +(test-equal "date+ month" #2020-10-10 (date+ #2020-01-10 (date month: 9))) +(test-equal "date+ day/month" #2020-10-10 (date+ #2020-01-01 (date day: 9 month: 9))) +;; (test-equal "date+ year" #4040-10-10 (date+ #2020-10-10 (date year: 2020))) + +(test-assert "date+ first literal" (date+ #2020-01-01 (date day: 0))) +(test-assert "date+ second literal" (date+ (date year: 1 month: 1 day: 1) #0001-00-00)) +(test-assert "date+ both literal" (date+ #2020-01-01 #0000-00-00)) + +(test-equal "date+ year overflow" #2019-01-01 (date+ #2018-12-31 (date day: 1))) +(test-equal "date- year overflow" #2018-12-31 (date- #2019-01-01 (date day: 1))) + +;; (test-equal "date+ large" #4040-10-10 (date+ #2020-05-03 #2020-05-07)) + +(test-equal "date- large" #0001-01-01 (date- #2020-01-01 #2019-00-00)) + +;; Datum är spännande +(test-equal "date- equal" (date year: -1 month: 11 day: 31) + (date- #2020-01-01 #2020-01-01)) + +(test-equal #2020-01-01T10:00:00 (datetime date: #2020-01-01 + time: #10:00:00)) +(test-equal #2020-01-01T10:00:00 + (datetime+ (datetime date: #2020-01-01) + (datetime time: #10:00:00))) + + +(test-equal #2020-03-10 + (date+ #2020-03-01 + (date day: 4) + (date day: 5))) + + +(test-assert "date< empty" + (date<)) + +(test-assert "date< single" + (date< #2020-01-10)) + +(test-assert "date< double" + (date< #2020-01-10 #2020-01-11)) + +(test-assert "date< tripple" + (date< #2020-01-10 #2020-01-11 #2020-01-12)) + +(test-assert "date< tripple negate" + (not (date< #2020-01-10 #2020-01-12 #2020-01-11))) + +(test-assert + (datetime- #2018-01-17T10:00:00 + #2018-01-17T08:00:00)) + + +(test-assert + (datetime<=? (datetime time: (time hour: 24)) + (datetime- #2018-01-17T10:00:00 + #2018-01-17T08:00:00))) diff --git a/tests/time.scm b/tests/time.scm deleted file mode 100644 index 65edfcbd..00000000 --- a/tests/time.scm +++ /dev/null @@ -1,58 +0,0 @@ -(((srfi srfi-19 util) - date day-stream normalize-date - drop-time normalize-date/tz - ) - ((util) set let-env) - ((srfi srfi-19) date-day) - ) - -(test-equal "Trivial normalize case" - (date year: 2020 month: 1 day: 1 tz: 0) - (normalize-date (date year: 2020 month: 1 day: 1 tz: 0))) - -(test-equal "Trivial case, with timezone" - (date year: 2020 month: 1 day: 1 tz: 3600) - (normalize-date (date year: 2020 month: 1 day: 1 tz: 3600))) - -;;; summer time begins 02:00 (becomes 03:00) during the night -;;; between the 28 and 29 of mars 2020, for Europe/Stockholm. -;;; (CET → CEST alt. UTC+1 → UTC+2) - -(test-equal "Time zone spill over" - (date year: 2020 month: 3 day: 29 tz: 3600) - (normalize-date (set (date-day (date year: 2020 month: 3 day: 28 tz: 3600)) - = (+ 1)))) - -;;; TODO normalize-date* - - - -;;; !!! TODO !!! - -(test-assert "normalize-date/tz" - (not (unspecified? (normalize-date/tz (date))))) - -(test-equal "Trivial normalize case" - (date year: 2020 month: 1 day: 1 hour: 1 tz: 3600) - (normalize-date/tz (date year: 2020 month: 1 day: 1 tz: 0) - "Europe/Stockholm")) - -(test-equal "Trivial case, with timezone" - (date year: 2020 month: 1 day: 1 tz: 3600) - (normalize-date/tz (date year: 2020 month: 1 day: 1 tz: 3600) - "Europe/Stockholm")) - -(test-equal "Time zone spill over" - (date year: 2020 month: 3 day: 30 hour: 1 tz: 7200) - (normalize-date/tz (set (date-day (date year: 2020 month: 3 day: 29 tz: 3600)) - = (+ 1)) - "Europe/Stockholm")) - - - - -(test-equal "drop time" - (date) - (drop-time (date hour: 10 minute: 70 second: 100))) - - diff --git a/tests/vcomponent.scm b/tests/vcomponent.scm new file mode 100644 index 00000000..c64f1a9b --- /dev/null +++ b/tests/vcomponent.scm @@ -0,0 +1,12 @@ +(((vcomponent base) attr) + ((vcomponent) parse-calendar)) + +(define ev (call-with-input-string + "BEGIN:VEVENT +KEY:value +END:VEVENT" + parse-calendar)) + +(test-assert (eq? #f (attr ev 'MISSING)) ) +(test-assert (attr ev 'KEY)) +(test-equal "value" (attr ev 'KEY)) -- cgit v1.2.3