From 8eab5b0063137f8008562c5069a9f14ed34355b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 18 Apr 2023 19:30:51 +0200 Subject: 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. --- tests/formats/README.md | 9 +++++ tests/formats/event.ics | 27 +++++++++++++ tests/formats/event.xcs | 50 ++++++++++++++++++++++++ tests/formats/ical.scm | 24 ++++++++++++ tests/formats/test.scm | 101 ++++++++++++++++++++++++++++++++++++++++++++++++ tests/formats/xcal.scm | 26 +++++++++++++ 6 files changed, 237 insertions(+) create mode 100644 tests/formats/README.md create mode 100644 tests/formats/event.ics create mode 100644 tests/formats/event.xcs create mode 100644 tests/formats/ical.scm create mode 100755 tests/formats/test.scm create mode 100644 tests/formats/xcal.scm 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 @@ + + + + + + -//PIMUTILS.ORG//NONSGML khal / icalendar //EN + + + 2.0 + + + + + + + Europe/Stockholm + + + + + + 2018-03-25T03:00:00 + CEST + +0100 + +0200 + + + + + 2018-10-28T02:00:00 + CET + +0200 + +0100 + + + + + + + Europe/Stockholm2018-09-07T18:00:00 + 2018-09-07T15:42:23Z + Europe/Stockholm2018-09-07T17:00:00 + 0 + Backhäfv + ZSGUP6BTM52UV42SEWBICHSS63V8DYQX5TSZ + + + + + 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)) -- cgit v1.2.3