From 9b28572aefbfecbb9caf96a54bdb4a817edbad61 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 16 Oct 2023 14:57:08 +0200 Subject: Rewrote the data format 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 | 102 -------------------------------- tests/formats/xcal.scm | 26 --------- tests/unit/formats/README.md | 14 +++++ tests/unit/formats/run.scm | 130 +++++++++++++++++++++++++++++++++++++++++ tests/unit/formats/target.ics | 18 ++++++ tests/unit/formats/target.sxml | 32 ++++++++++ tests/unit/formats/target.xml | 68 +++++++++++++++++++++ 11 files changed, 262 insertions(+), 238 deletions(-) delete mode 100644 tests/formats/README.md delete mode 100644 tests/formats/event.ics delete mode 100644 tests/formats/event.xcs delete mode 100644 tests/formats/ical.scm delete mode 100755 tests/formats/test.scm delete mode 100644 tests/formats/xcal.scm create mode 100644 tests/unit/formats/README.md create mode 100644 tests/unit/formats/run.scm create mode 100644 tests/unit/formats/target.ics create mode 100644 tests/unit/formats/target.sxml create mode 100644 tests/unit/formats/target.xml 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 @@ - - - - - - -//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 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 @@ + + + + + + GREGORIAN + + + -//CALP-TEST//x.y + + + 2.0 + + + + + + + + + BASE64 + + + text/plain + + + Cg== + + + PUBLIC + + + A comment + + + 2023-05-10T10:20:00 + + + + + sv + + + Beskrivning av händelsen + + + 2023-05-01T00:00:00 + + + Room 5 + + + 5 + + + CANCELLED + + + Event summary + + + e4e812b8-dbb9-438d-ba56-ab58321fe4e1 + + + + + + -- cgit v1.2.3