diff options
| author | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-11-13 22:06:13 +0100 |
|---|---|---|
| committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2023-11-16 00:51:19 +0100 |
| commit | 34059d4d71cb8081d065467cd32e31c2aa21c728 (patch) | |
| tree | 0b779efbd15f6deff6844ba10d4801ecfb8a381f | |
| parent | STASH: Start writing vcomponent datetime tests. (diff) | |
| download | calp-34059d4d71cb8081d065467cd32e31c2aa21c728.tar.gz calp-34059d4d71cb8081d065467cd32e31c2aa21c728.tar.xz | |
Add vcomponent-equal?.
| -rw-r--r-- | module/vcomponent.scm | 2 | ||||
| -rw-r--r-- | module/vcomponent/base.scm | 10 | ||||
| -rw-r--r-- | tests/unit/vcomponent/vcomponent-equal.scm | 56 |
3 files changed, 68 insertions, 0 deletions
diff --git a/module/vcomponent.scm b/module/vcomponent.scm index 7930bf92..f5f2583e 100644 --- a/module/vcomponent.scm +++ b/module/vcomponent.scm @@ -6,6 +6,8 @@ :select (parse-cal-path)) :re-export ( vcomponent + vcomponent? + vcomponent-equal? set-properties properties children diff --git a/module/vcomponent/base.scm b/module/vcomponent/base.scm index 2a607fc5..4cacbb46 100644 --- a/module/vcomponent/base.scm +++ b/module/vcomponent/base.scm @@ -20,6 +20,8 @@ children type parent add-child + vcomponent-equal? + remove-property prop* prop extract extract* @@ -96,6 +98,14 @@ default: (table) type: table?) (parent default: #f type: (or false? vcomponent?))) +(define (vcomponent-equal? a b) + (and (eqv? (type a) (type b)) + (= (length (children a)) (length (children b))) + (every vcomponent-equal? + (sort* (children a) string< (extract 'UID)) + (sort* (children b) string< (extract 'UID))) + (equal? (properties a) (properties b)))) + (define prop* (case-lambda ((object key) diff --git a/tests/unit/vcomponent/vcomponent-equal.scm b/tests/unit/vcomponent/vcomponent-equal.scm new file mode 100644 index 00000000..5bae30c2 --- /dev/null +++ b/tests/unit/vcomponent/vcomponent-equal.scm @@ -0,0 +1,56 @@ +(define-module (test vcomponent-equal) + :use-module (srfi srfi-64) + :use-module (srfi srfi-88) + :use-module (datetime) + :use-module (datetime timespec) + :use-module (vcomponent create) + :use-module (vcomponent recurrence) + :use-module ((vcomponent) :select (vcomponent-equal?)) + ) + +;;; Things of note: +;;; - the childrens are in different order +;;; - All properties are in a random order +;;; TODO Add parameters +(test-assert "vcomponent equal?" + (vcomponent-equal? + (vtimezone tzid: "Europe/Zurich" + (list + (daylight + tzoffsetfrom: (make-timespec (time hour: 0) '+ #\w) + tzoffsetto: (make-timespec (time hour: 2) '+ #\w) + tzname: "CEST" + dtstart: (datetime year: 1981 month: 3 day: 29 hour: 1 tz: "UTC") + uid: "d19c9347-9a85-4432-a876-5fb9c0d24d2b" + rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun)) + bymonth: '(3) wkst: monday)) + (standard + tzoffsetfrom: (make-timespec (time hour: 2) '+ #\w) + uid: "7dce30d4-6aaa-4cfb-85dc-813f74d7f4a9" + dtstart: (datetime year: 1996 month: 10 day: 27 hour: 1 tz: "UTC") + rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun)) + bymonth: '(10) wkst: monday) + tzoffsetto: (make-timespec (time hour: 1) '+ #\w) + tzname: "CET"))) + + (vtimezone tzid: "Europe/Zurich" + (list + (standard + dtstart: (datetime year: 1996 month: 10 day: 27 hour: 1 tz: "UTC") + rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun)) + bymonth: '(10) wkst: monday) + tzname: "CET" + tzoffsetfrom: (make-timespec (time hour: 2) '+ #\w) + tzoffsetto: (make-timespec (time hour: 1) '+ #\w) + uid: "7dce30d4-6aaa-4cfb-85dc-813f74d7f4a9") + (daylight + dtstart: (datetime year: 1981 month: 3 day: 29 hour: 1 tz: "UTC") + rrule: (recur-rule freq: 'YEARLY interval: 1 byday: `((-1 . ,sun)) + bymonth: '(3) wkst: monday) + tzname: "CEST" + tzoffsetfrom: (make-timespec (time hour: 0) '+ #\w) + tzoffsetto: (make-timespec (time hour: 2) '+ #\w) + uid: "d19c9347-9a85-4432-a876-5fb9c0d24d2b"))))) + + +'((vcomponent base)) |