Rewrote the data format tests.

11 files changed, 262 insertions, 238 deletions

diff --git a/tests/formats/README.md b/tests/formats/README.md
deleted file mode 100644
index b17bd866..00000000
--- a/tests/formats/README.md
+++ /dev/null
@@ -1,9 +0,0 @@
-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
deleted file mode 100644
index 5b578627..00000000
--- a/tests/formats/event.ics
+++ /dev/null
@@ -1,27 +0,0 @@
-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
deleted file mode 100644
index c3fd817f..00000000
--- a/tests/formats/event.xcs
+++ /dev/null
@@ -1,50 +0,0 @@
-<?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
deleted file mode 100644
index 5747e2ea..00000000
--- a/tests/formats/ical.scm
+++ /dev/null
@@ -1,24 +0,0 @@
-(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
deleted file mode 100755
index 48c6bb76..00000000
--- a/tests/formats/test.scm
+++ /dev/null
@@ -1,102 +0,0 @@
-#!/usr/bin/env bash
-# -*- mode: scheme; geiser-scheme-implementation: guile -*-
-
-here=$(dirname $(realpath $0))
-export here
-root="$(dirname "$(dirname "$here")")"
-eval $(env __PRINT_ENVIRONMENT=1 "${root}/calp")
-
-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 display))
-
-(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-group "Deserialize"
-             (let ((object (call-with-input-string component-str deserialize)))
-               (test-assert "Deserialize worked" (vcomponent? object))
-
-               (test-equal "Deserialized object serializes back into source"
-                 (sanitize-string component-str)
-                 (sanitize-string
-                  (call-with-output-string
-                    (lambda (p) (serialize object 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
deleted file mode 100644
index 4c27931a..00000000
--- a/tests/formats/xcal.scm
+++ /dev/null
@@ -1,26 +0,0 @@
-(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))
diff --git a/tests/unit/formats/README.md b/tests/unit/formats/README.md
new file mode 100644
index 00000000..c41a0c58
--- /dev/null
+++ b/tests/unit/formats/README.md
@@ -0,0 +1,14 @@
+Data format tests
+=================
+
+These aren't really unit tests, but run fine through the same
+framework.
+
+The file [`run.scm`](run.scm) contains a reference calendar (or
+"master record") component which should contain all weird cases which
+may be encountered. It then tries to serialize this component to all
+registered serialization formats (iCalendar, xCalendar, ...) and
+checks it against a pre vetted reference file.
+
+It then takes the serialized form and parses it back into a Guile data
+structure, and checks it against the "master record".
diff --git a/tests/unit/formats/run.scm b/tests/unit/formats/run.scm
new file mode 100644
index 00000000..5ec277ca
--- /dev/null
+++ b/tests/unit/formats/run.scm
@@ -0,0 +1,130 @@
+(define-module (test formats run)
+  :use-module (srfi srfi-64)
+  :use-module (srfi srfi-88)
+  :use-module ((hnh util) :select (->))
+  :use-module (hnh util path)
+  :use-module ((ice-9 rdelim) :select (read-string))
+  :use-module (ice-9 pretty-print)
+  :use-module (rnrs io ports)
+  :use-module (datetime)
+  :use-module (vcomponent create)
+  :use-module ((vcomponent formats ical) :prefix #{ics:}#)
+  :use-module ((vcomponent formats xcal) :prefix #{xcs:}#)
+  :use-module ((vcomponent formats sxcal) :prefix #{sxcs:}#)
+  :use-module (sxml namespaced)
+  :use-module ((calp namespaces) :select (xcal))
+  :use-module (hnh test xmllint)
+
+  ;; Requirements for the reference component
+  :use-module ((hnh util) :select (->))
+  :use-module (datetime)
+  :use-module (vcomponent create)
+  :use-module (rnrs io ports)
+  )
+
+;;; Reference component. This component should be built to
+;;; contain all weird cases which may be encountered.
+(define ev
+ (vcalendar
+  calscale: "GREGORIAN"
+  ;; method: ""
+  prodid: "-//CALP-TEST//x.y"
+  version: "2.0"
+  (list
+   (vevent
+    attach: (with-parameters fmttype: "text/plain"
+                             encoding: "BASE64"
+                             value: "BINARY"
+                             (-> "\n"
+                                 (string->bytevector
+                                  (make-transcoder (utf-8-codec)))))
+    ;; categories: '("a" "b")
+    class: 'PUBLIC
+    comment: "A comment"
+    description: "Descrition of the event"
+    description: (with-parameters language: "sv" "Beskrivning av händelsen")
+    ;; geo: (make-geo 10 20)
+    location: "Room 5"
+    priority: 5
+    ;; resources:
+    status: 'CANCELLED
+    summary: "Event summary"
+    completed: (datetime year: 2023 month: may day: 10 hour: 10 minute: 20)
+    dtstart: (datetime year: 2023 month: may day: 1)
+    uid: "e4e812b8-dbb9-438d-ba56-ab58321fe4e1"
+    ;; dtend: (date year: 2023 month: may day: 5)
+    ;; TODO duration (on another component)
+    ;; freebusy:
+    ;; trasp: 'TRANSPARENT
+    ))))
+
+
+
+(define* (run-test name reference
+                   key:
+                   serialize
+                   parse)
+
+  ;; Assert serialize is set
+
+  (define target
+    (call-with-input-file (path-append (dirname (current-filename))
+                                       reference)
+      read-string))
+
+  (define serialized-component
+    (call-with-output-string
+      (lambda (port) (serialize ev port))))
+
+  (test-equal (string-append "serialise " name)
+    target serialized-component)
+
+  (when parse
+   (test-equal (string-append "parse " name)
+     (list ev)
+     (call-with-input-string serialized-component parse))))
+
+
+
+;;; Currently many of these have some extra baggage in their
+;;; serialise or parse forms. This should be kept to a minimum,
+;;; to ensure that all implementations are compatible.
+;;; However, reflowing data for better diffs is acceptable.
+
+(test-group "iCalendar"
+  (run-test
+   "iCalendar" "target.ics"
+   serialize: ics:serialize
+   parse: ics:deserialize))
+
+(test-group "sxCalendar"
+  (run-test
+   "sxCalendar" "target.sxml"
+   serialize:
+   (lambda (ev p)
+     (pretty-print
+      (namespaced-sxml->sxml
+       ((@@ (vcomponent formats sxcal) serialize/object) ev)
+       `((,xcal . xcal)))
+      p))))
+
+(test-group "xCalendar"
+  (run-test
+   "xCalendar" "target.xml"
+   serialize: (lambda (ev p)
+                (-> (call-with-output-string
+                      (lambda (port) (xcs:serialize ev port)))
+                    xmllint
+                    (display p)))))
+
+
+
+'((vcomponent formats xcal)
+  (vcomponent formats xcal output)
+  (vcomponent formats xcal parse)
+  (vcomponent formats xcal types)
+
+  (vcomponent formats ical)
+  (vcomponent formats ical output)
+  (vcomponent formats ical parse)
+  (vcomponent formats ical types))
diff --git a/tests/unit/formats/target.ics b/tests/unit/formats/target.ics
new file mode 100644
index 00000000..0255432a
--- /dev/null
+++ b/tests/unit/formats/target.ics
@@ -0,0 +1,18 @@
+BEGIN:VCALENDAR

+CALSCALE:GREGORIAN

+PRODID:-//CALP-TEST//x.y

+VERSION:2.0

+BEGIN:VEVENT

+ATTACH;ENCODING=BASE64;FMTTYPE=text/plain;VALUE=BINARY:Cg==

+CLASS:PUBLIC

+COMMENT:A comment

+COMPLETED:20230510T102000

+DESCRIPTION;LANGUAGE=sv:Beskrivning av händelsen

+DTSTART:20230501T000000

+LOCATION:Room 5

+PRIORITY:5

+STATUS:CANCELLED

+SUMMARY:Event summary

+UID:e4e812b8-dbb9-438d-ba56-ab58321fe4e1

+END:VEVENT

+END:VCALENDAR

diff --git a/tests/unit/formats/target.sxml b/tests/unit/formats/target.sxml
new file mode 100644
index 00000000..1f9e4a1e
--- /dev/null
+++ b/tests/unit/formats/target.sxml
@@ -0,0 +1,32 @@
+(*TOP* (xcal:vcalendar
+         (@ (xmlns:xcal
+              "urn:ietf:params:xml:ns:icalendar-2.0"))
+         (xcal:properties
+           (xcal:calscale (xcal:text "GREGORIAN"))
+           (xcal:prodid (xcal:text "-//CALP-TEST//x.y"))
+           (xcal:version (xcal:text "2.0")))
+         (xcal:components
+           (xcal:vevent
+             (xcal:properties
+               (xcal:attach
+                 (xcal:parameters
+                   (xcal:encoding (xcal:text "BASE64"))
+                   (xcal:fmttype (xcal:text "text/plain")))
+                 (xcal:binary "Cg=="))
+               (xcal:class (xcal:text "PUBLIC"))
+               (xcal:comment (xcal:text "A comment"))
+               (xcal:completed
+                 (xcal:date-time "2023-05-10T10:20:00"))
+               (xcal:description
+                 (xcal:parameters
+                   (xcal:language (xcal:text "sv")))
+                 (xcal:text "Beskrivning av händelsen"))
+               (xcal:dtstart
+                 (xcal:date-time "2023-05-01T00:00:00"))
+               (xcal:location (xcal:text "Room 5"))
+               (xcal:priority (xcal:integer "5"))
+               (xcal:status (xcal:text "CANCELLED"))
+               (xcal:summary (xcal:text "Event summary"))
+               (xcal:uid
+                 (xcal:text
+                   "e4e812b8-dbb9-438d-ba56-ab58321fe4e1")))))))
diff --git a/tests/unit/formats/target.xml b/tests/unit/formats/target.xml
new file mode 100644
index 00000000..e6c98f44
--- /dev/null
+++ b/tests/unit/formats/target.xml
@@ -0,0 +1,68 @@
+<?xml version="1.0"?>
+<xcal:icalendar xmlns:xcal="urn:ietf:params:xml:ns:icalendar-2.0">
+  <xcal:vcalendar>
+    <xcal:properties>
+      <xcal:calscale>
+        <xcal:text>GREGORIAN</xcal:text>
+      </xcal:calscale>
+      <xcal:prodid>
+        <xcal:text>-//CALP-TEST//x.y</xcal:text>
+      </xcal:prodid>
+      <xcal:version>
+        <xcal:text>2.0</xcal:text>
+      </xcal:version>
+    </xcal:properties>
+    <xcal:components>
+      <xcal:vevent>
+        <xcal:properties>
+          <xcal:attach>
+            <xcal:parameters>
+              <xcal:encoding>
+                <xcal:text>BASE64</xcal:text>
+              </xcal:encoding>
+              <xcal:fmttype>
+                <xcal:text>text/plain</xcal:text>
+              </xcal:fmttype>
+            </xcal:parameters>
+            <xcal:binary>Cg==</xcal:binary>
+          </xcal:attach>
+          <xcal:class>
+            <xcal:text>PUBLIC</xcal:text>
+          </xcal:class>
+          <xcal:comment>
+            <xcal:text>A comment</xcal:text>
+          </xcal:comment>
+          <xcal:completed>
+            <xcal:date-time>2023-05-10T10:20:00</xcal:date-time>
+          </xcal:completed>
+          <xcal:description>
+            <xcal:parameters>
+              <xcal:language>
+                <xcal:text>sv</xcal:text>
+              </xcal:language>
+            </xcal:parameters>
+            <xcal:text>Beskrivning av h&#xE4;ndelsen</xcal:text>
+          </xcal:description>
+          <xcal:dtstart>
+            <xcal:date-time>2023-05-01T00:00:00</xcal:date-time>
+          </xcal:dtstart>
+          <xcal:location>
+            <xcal:text>Room 5</xcal:text>
+          </xcal:location>
+          <xcal:priority>
+            <xcal:integer>5</xcal:integer>
+          </xcal:priority>
+          <xcal:status>
+            <xcal:text>CANCELLED</xcal:text>
+          </xcal:status>
+          <xcal:summary>
+            <xcal:text>Event summary</xcal:text>
+          </xcal:summary>
+          <xcal:uid>
+            <xcal:text>e4e812b8-dbb9-438d-ba56-ab58321fe4e1</xcal:text>
+          </xcal:uid>
+        </xcal:properties>
+      </xcal:vevent>
+    </xcal:components>
+  </xcal:vcalendar>
+</xcal:icalendar>