From 9b28572aefbfecbb9caf96a54bdb4a817edbad61 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Mon, 16 Oct 2023 14:57:08 +0200
Subject: Rewrote the data format tests.

---
 tests/formats/test.scm | 102 -------------------------------------------------
 1 file changed, 102 deletions(-)
 delete mode 100755 tests/formats/test.scm

(limited to 'tests/formats/test.scm')

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)
-- 
cgit v1.2.3