blob: 48c6bb762f208564af461cfc035eafdeccdac033 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
#!/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)
|
