Once again compiles.

7 files changed, 278 insertions, 71 deletions

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))