Add tests for serialization foramts.

These are outside the regular unit testing, since they are more of end
to end tests. Parts of this functionality is however still in the unit
tests.

6 files changed, 237 insertions, 0 deletions

diff --git a/tests/formats/README.md b/tests/formats/README.md
new file mode 100644
index 00000000..b17bd866
--- /dev/null
+++ b/tests/formats/README.md
@@ -0,0 +1,9 @@
+Serialization and deserialization formats
+=========================================
+
+`test.scm` runs every other test.
+
+xcal
+----
+
+The program handles xml trees with a default namespace fine, but diff does not.
diff --git a/tests/formats/event.ics b/tests/formats/event.ics
new file mode 100644
index 00000000..5b578627
--- /dev/null
+++ b/tests/formats/event.ics
@@ -0,0 +1,27 @@
+BEGIN:VCALENDAR

+PRODID:-//PIMUTILS.ORG//NONSGML khal / icalendar //EN

+VERSION:2.0

+BEGIN:VTIMEZONE

+TZID:Europe/Stockholm

+BEGIN:DAYLIGHT

+DTSTART;VALUE=DATE-TIME:20180325T030000

+TZNAME:CEST

+TZOFFSETFROM:+0100

+TZOFFSETTO:+0200

+END:DAYLIGHT

+BEGIN:STANDARD

+DTSTART;VALUE=DATE-TIME:20181028T020000

+TZNAME:CET

+TZOFFSETFROM:+0200

+TZOFFSETTO:+0100

+END:STANDARD

+END:VTIMEZONE

+BEGIN:VEVENT

+DTEND;TZID=Europe/Stockholm;VALUE=DATE-TIME:20180907T180000

+DTSTAMP;VALUE=DATE-TIME:20180907T154223Z

+DTSTART;TZID=Europe/Stockholm;VALUE=DATE-TIME:20180907T170000

+SEQUENCE:0

+SUMMARY:Backhäfv

+UID:ZSGUP6BTM52UV42SEWBICHSS63V8DYQX5TSZ

+END:VEVENT

+END:VCALENDAR

diff --git a/tests/formats/event.xcs b/tests/formats/event.xcs
new file mode 100644
index 00000000..c3fd817f
--- /dev/null
+++ b/tests/formats/event.xcs
@@ -0,0 +1,50 @@
+<?xml version="1.0"?>
+<c:icalendar xmlns:c="urn:ietf:params:xml:ns:icalendar-2.0">
+  <c:vcalendar>
+    <c:properties>
+      <c:prodid>
+        <c:text>-//PIMUTILS.ORG//NONSGML khal / icalendar //EN</c:text>
+      </c:prodid>
+      <c:version>
+        <c:text>2.0</c:text>
+      </c:version>
+    </c:properties>
+    <c:components>
+      <c:vtimezone>
+        <c:properties>
+          <c:tzid>
+            <c:text>Europe/Stockholm</c:text>
+          </c:tzid>
+        </c:properties>
+        <c:components>
+          <c:daylight>
+            <c:properties>
+              <c:dtstart><c:date-time>2018-03-25T03:00:00</c:date-time></c:dtstart>
+              <c:tzname><c:text>CEST</c:text></c:tzname>
+              <c:tzoffsetfrom><c:utc-offset>+0100</c:utc-offset></c:tzoffsetfrom>
+              <c:tzoffsetto><c:utc-offset>+0200</c:utc-offset></c:tzoffsetto>
+            </c:properties>
+          </c:daylight>
+          <c:standard>
+            <c:properties>
+              <c:dtstart><c:date-time>2018-10-28T02:00:00</c:date-time></c:dtstart>
+              <c:tzname><c:text>CET</c:text></c:tzname>
+              <c:tzoffsetfrom><c:utc-offset>+0200</c:utc-offset></c:tzoffsetfrom>
+              <c:tzoffsetto><c:utc-offset>+0100</c:utc-offset></c:tzoffsetto>
+            </c:properties>
+          </c:standard>
+        </c:components>
+      </c:vtimezone>
+      <c:vevent>
+        <c:properties>
+          <c:dtend><c:parameters><c:tzid><c:text>Europe/Stockholm</c:text></c:tzid></c:parameters><c:date-time>2018-09-07T18:00:00</c:date-time></c:dtend>
+          <c:dtstamp><c:date-time>2018-09-07T15:42:23Z</c:date-time></c:dtstamp>
+          <c:dtstart><c:parameters><c:tzid><c:text>Europe/Stockholm</c:text></c:tzid></c:parameters><c:date-time>2018-09-07T17:00:00</c:date-time></c:dtstart>
+          <c:sequence><c:integer>0</c:integer></c:sequence>
+          <c:summary><c:text>Backh&#xE4;fv</c:text></c:summary>
+          <c:uid><c:text>ZSGUP6BTM52UV42SEWBICHSS63V8DYQX5TSZ</c:text></c:uid>
+        </c:properties>
+      </c:vevent>
+    </c:components>
+  </c:vcalendar>
+</c:icalendar>
diff --git a/tests/formats/ical.scm b/tests/formats/ical.scm
new file mode 100644
index 00000000..5747e2ea
--- /dev/null
+++ b/tests/formats/ical.scm
@@ -0,0 +1,24 @@
+(define-module (ical)
+  :use-module (srfi srfi-88)
+  :use-module ((hnh util) :select (sort*))
+  :use-module (hnh util path)
+  :use-module ((rnrs io ports) :select (get-string-all))
+  :use-module ((vcomponent formats ical) :prefix #{ics:}#)
+  :export (sanitize-string
+           serialize
+           deserialize
+           component-str))
+
+;; Technically not back into source, since order of children isn't
+;; stable. That's also why we just check that all lines are present,
+;; regardless of order.
+(define (sanitize-string str)
+  (sort* (string-split str #\newline)
+         string<))
+
+(define serialize ics:serialize)
+(define deserialize ics:deserialize)
+
+(define component-str
+  (call-with-input-file (path-append (getenv "here") "event.ics")
+    get-string-all))
diff --git a/tests/formats/test.scm b/tests/formats/test.scm
new file mode 100755
index 00000000..b4a00a73
--- /dev/null
+++ b/tests/formats/test.scm
@@ -0,0 +1,101 @@
+#!/usr/bin/env bash
+# -*- mode: scheme; geiser-scheme-implementation: guile -*-
+
+here=$(dirname $(realpath $0))
+export here
+. "$(dirname $(dirname "$here"))/env"
+
+exec $GUILE -s "$0" "$@"
+!#
+
+(use-modules (srfi srfi-64)
+             (srfi srfi-88)
+             (vcomponent)
+             (vcomponent create)
+             (datetime)
+             (datetime timespec)
+             ((hnh util) :select (for print-and-return))
+             (hnh test testrunner))
+
+
+(verbose? #t)
+(test-runner-factory construct-test-runner)
+
+(define component
+  (vcomponent
+   'VCALENDAR
+   version: "2.0"
+   prodid: "-//PIMUTILS.ORG//NONSGML khal / icalendar //EN"
+   (list
+    (vcomponent
+     'VEVENT
+     summary: "Backhäfv"
+     dtstart: (with-parameters tzid: "Europe/Stockholm"
+                               value: "DATE-TIME"
+                               #2018-09-07T17:00:00)
+     dtend: (with-parameters tzid: "Europe/Stockholm"
+                             value: "DATE-TIME"
+                             #2018-09-07T18:00:00)
+     dtstamp: (with-parameters value: "DATE-TIME"
+                               #2018-09-07T15:42:23Z)
+     uid: "ZSGUP6BTM52UV42SEWBICHSS63V8DYQX5TSZ"
+     sequence: 0)
+    (vcomponent
+     'VTIMEZONE
+     tzid: "Europe/Stockholm"
+     (list (vcomponent
+            'STANDARD
+            dtstart: (with-parameters value: "DATE-TIME"
+                                      #2018-10-28T02:00:00)
+            tzname: "CET"
+            tzoffsetfrom: (make-timespec #02:00 '+ #\z)
+            tzoffsetto: (make-timespec #01:00 '+ #\z))
+           (vcomponent
+            'DAYLIGHT
+            dtstart: (with-parameters value: "DATE-TIME"
+                                      #2018-03-25T03:00:00)
+            tzname: "CEST"
+            tzoffsetfrom: (make-timespec #01:00 '+ #\z)
+            tzoffsetto: (make-timespec #02:00 '+ #\z))))
+    )))
+
+(add-to-load-path (getenv "here"))
+
+(test-begin "Serialization Formats")
+
+
+
+(for test in '(ical xcal)
+     (test-group (format #f "Format: ~a" test)
+       (let ((interface (resolve-interface (list test))))
+         (let ((component-str   (module-ref interface 'component-str))
+               (serialize       (module-ref interface 'serialize))
+               (deserialize     (module-ref interface 'deserialize))
+               (sanitize-string (module-ref interface 'sanitize-string)))
+
+           (test-equal "Serialize"
+             (sanitize-string component-str)
+             (sanitize-string
+              (call-with-output-string
+                (lambda (p) (serialize component p)))))
+
+           (test-equal "Deserialized object serializes back into source"
+             (sanitize-string component-str)
+             (sanitize-string
+              (call-with-output-string
+                (lambda (p)
+                  (serialize
+                   (call-with-input-string
+                       component-str deserialize)
+                   p)))))
+
+
+           (test-assert "Serialized string can still be read back in"
+             (vcomponent?
+              (let* ((obj1 (call-with-input-string component-str deserialize))
+                     (str2 (call-with-output-string (lambda (p) (serialize obj1 p))))
+                     (obj2 (call-with-input-string str2 deserialize)))
+                obj2)))))))
+
+
+(test-end)
diff --git a/tests/formats/xcal.scm b/tests/formats/xcal.scm
new file mode 100644
index 00000000..4c27931a
--- /dev/null
+++ b/tests/formats/xcal.scm
@@ -0,0 +1,26 @@
+(define-module (xcal)
+  :use-module (srfi srfi-88)
+  :use-module (hnh test xmllint)
+  :use-module (hnh util path)
+  :use-module ((rnrs io ports) :select (get-string-all))
+  :use-module ((vcomponent formats xcal) :prefix #{xcs:}#)
+  :use-module ((calp namespaces) :select (xcal))
+  :export (sanitize-string
+           serialize
+           deserialize
+           component-str))
+
+(define (sanitize-string str)
+  (xmllint str))
+
+(define serialize
+  (lambda (component port)
+    (xcs:serialize
+     component port namespaces: `((,xcal . c))
+     )))
+
+(define deserialize xcs:deserialize)
+
+(define component-str
+  (call-with-input-file (path-append (getenv "here") "event.xcs")
+    get-string-all))