Reworked tests.

7 files changed, 98 insertions, 76 deletions

diff --git a/tests/let.scm b/tests/let.scm
index 02e38a42..14a246d2 100644
--- a/tests/let.scm
+++ b/tests/let.scm
@@ -1,7 +1,8 @@
-(use-modules (util))
+(((util) let*)
+ ((guile) set!))
 
 (test-assert (let* ((a #t)) a))
-(test-assert (let* (((a . b) '(#t . #f))) a))
+(test-assert (let* (((a . b) (cons #t #f))) a))
 (test-assert (let* (((a . b) (cons* #f #t))) b))
 (test-assert (let* ((a b c (values #f #t #f))) b))
 (test-assert (let* (((a b c) (list #f #t #f))) b))
@@ -12,3 +13,4 @@
 (test-equal 30 (let* (x y) (set! x 10) (set! y 20) (+ x y)))
 (test-assert (let* (x) (not x)))
 (test-equal 6 (let* ((x 1) y z) (set! y 2) (set! z 3) (+ x y z)))
+
diff --git a/tests/prop.scm b/tests/prop.scm
index 15ccb355..a302d790 100644
--- a/tests/prop.scm
+++ b/tests/prop.scm
@@ -1,9 +1,12 @@
-(use-modules (vcomponent)
-             (util))
+(((vcomponent base) prop attr* properties)
+ ((vcomponent parse) parse-calendar)
+ ((util) sort*))
 
-(define v (make-vcomponent
-           (string-append (getenv "TESTPATH")
-                          "/prop.ics")))
+(define v (call-with-input-string
+              "BEGIN:VCOMPONENT
+KEY;A=1;B=2:Some text
+END:VCOMPONENT"
+              parse-calendar))
 
 (test-equal '("1") (prop (attr* v 'KEY) 'A))
 (test-equal '("2") (prop (attr* v 'KEY) 'B))
diff --git a/tests/recurring.scm b/tests/recurring.scm
index 331343c6..ce5a12fd 100644
--- a/tests/recurring.scm
+++ b/tests/recurring.scm
@@ -1,47 +1,41 @@
-(use-modules (srfi srfi-1)
-             (srfi srfi-19)
-             (srfi srfi-19 util)
-             (srfi srfi-41)
-
-             (util)
-             (vcomponent)
-             (vcomponent output)
-             (vcomponent recurrence))
-
-(define (display-timespan ev)
-  (format #t "~a -- ~a~%"
-          (time->string (attr ev "DTSTART"))
-          (time->string (attr ev "DTEND"))))
-
-(define (tcal str)
-  (format #f "~a/recurrence/~a"
-          (getenv "TESTPATH")
-          str))
-
-(define cal-1 (make-vcomponent (tcal "simple-daily.ics")))
-
-(let ((ev (car (children cal-1 'VEVENT))))
-  (format #t "~a~%" (attr ev 'RRULE))
+(((srfi srfi-41) stream-take stream-map)
+ ((srfi srfi-1) find)
+ ((guile) make-struct/no-tail)
+ ((vcomponent base) children extract type)
+ ((vcomponent) parse-calendar)
+ ((vcomponent recurrence) generate-recurrence-set))
+
+(define cal-1
+  (call-with-input-string
+      "BEGIN:VCALENDAR
+VERSION:2.0
+PRODID:-Manual baby!
+BEGIN:VEVENT
+SUMMARY:Repeating event
+DTSTART;20190302T160000
+DTEND;VALUE=DATE-TIME:20190302T170000
+DTSTAMP;VALUE=DATE-TIME:20190302T165849Z
+UID:USG7HSRFJSZ6YURWCNSH3UCKI2PHP19SWGBG
+SEQUENCE:0
+RRULE:FREQ=DAILY
+END:VEVENT
+END:VCALENDAR"
+    parse-calendar))
+
+(let ((ev (find (lambda (e) (eq? 'VEVENT (type e))) (children cal-1))))
+  (test-assert "Generate Recurrence set" (generate-recurrence-set ev))
 
   (test-equal "Generate First"
-    (map (extract 'DTSTART)
-         (stream->list (stream-take 5 (generate-recurrence-set ev))))
-    (let* ((s0 (attr ev 'DTSTART))
-           (s1 (add-day s0))
-           (s2 (add-day s1))
-           (s3 (add-day s2))
-           (s4 (add-day s3)))
-      (list s0 s1 s2 s3 s4)))
+    (stream-take 5 (stream-map (extract 'DTSTART)
+                               (generate-recurrence-set ev)))
+    (stream-take 5 (day-stream (attr ev 'DTSTART))))
 
   ;; We run the exact same thing a secound time, since I had an error with
   ;; that during development.
- (test-equal "Generate Again"
-    (map (extract 'DTSTART)
-         (stream->list (stream-take 5 (generate-recurrence-set ev))))
-    (let* ((s0 (attr ev 'DTSTART))
-           (s1 (add-day s0))
-           (s2 (add-day s1))
-           (s3 (add-day s2))
-           (s4 (add-day s3)))
-      (list s0 s1 s2 s3 s4))) )
+
+  ;; (test-equal "Generate Again"
+  ;;   (stream-take 5 (stream-map (extract 'DTSTART)
+  ;;                              (generate-recurrence-set ev)))
+  ;;   (stream-take 5 (day-stream (attr ev 'DTSTART))))
+  )
 
diff --git a/tests/rrule-parse.scm b/tests/rrule-parse.scm
index 7612afc8..d7733310 100644
--- a/tests/rrule-parse.scm
+++ b/tests/rrule-parse.scm
@@ -1,16 +1,11 @@
-(use-modules (vcomponent recurrence parse))
+(((vcomponent recurrence parse)
+  parse-recurrence-rule)
+ ((vcomponent recurrence) make-recur-rule))
 
-(define-syntax mkrule
-  (syntax-rules ()
-    ((_ (key val) ...)
-     ((record-constructor (@@ (vcomponent recurrence internal) <recur-rule>)
-                          (quote (key ...)))
-      (quote val) ...))))
-
-(test-equal (mkrule (freq HOURLY) (wkst MO) (interval 1))
+(test-equal (make-recur-rule (freq 'HOURLY) (wkst 'MO) (interval 1))
   (parse-recurrence-rule "FREQ=HOURLY"))
 
-(test-equal (mkrule (freq HOURLY) (count 3) (interval 1) (wkst MO))
+(test-equal (make-recur-rule (freq 'HOURLY) (count 3) (interval 1) (wkst 'MO))
     (parse-recurrence-rule "FREQ=HOURLY;COUNT=3"))
 
 ;;; TODO write tests for these cases
@@ -20,7 +15,7 @@
 ;; => #<<recur-rule> freq: #<<recur-rule> freq: #f until: #f count: #f interval: 1 bysecond: #f byminute: #f byhour: #f byday: #f bymonthday: #f byyearday: #f byweekno: #f bymonth: #f bysetpos: #f wkst: MO> until: #f count: 3 interval: 1 bysecond: #f byminute: #f byhour: #f byday: #f bymonthday: #f byyearday: #f byweekno: #f bymonth: #f bysetpos: #f wkst: MO>
 ;; ERR unfulfilled-constraint [ERR] doesn't fulfill constraint of type [FREQ], ignoring
 
-(parse-recurrence-rule "FREQ=HOURLY;COUNT=err")
+(test-error 'wrong-type-argument (parse-recurrence-rule "FREQ=HOURLY;COUNT=err"))
 ;; => #<<recur-rule> freq: HOURLY until: #f count: #f interval: 1
 ;;    bysecond: #f byminute: #f byhour: #f byday: #f bymonthday: #f
 ;;    byyearday: #f byweekno: #f bymonth: #f bysetpos: #f wkst: MO>
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
index 529878c7..c024f3a9 100755
--- a/tests/run-tests.scm
+++ b/tests/run-tests.scm
@@ -5,12 +5,17 @@
 (eval-when (compile load)
  (define here (dirname (current-filename))))
 
+(format #t "current filename = ~a~%" here)
+
+
 (add-to-load-path (format #f "~a/module"
                           (dirname here)))
 
 
 (use-modules (ice-9 ftw)
-             (ice-9 sandbox))
+             (ice-9 sandbox)
+             (srfi srfi-64)
+             ((util) :select (for)))
 
 (define files
   (scandir here
@@ -19,15 +24,37 @@
                   (not (string=? name (basename (current-filename))))
                   (string=? "scm" (string-take-right name 3))))))
 
-(setenv "TESTPATH"
-        (format #f "~a/testdata" (dirname here)))
 
-(use-modules (srfi srfi-64))
 
 ;; Load tests
 
-(add-to-load-path here)
+(define (read-multiple)
+(let loop ((done '()))
+  (let ((sexp (read)))
+    (if (eof-object? sexp)
+        (reverse done)
+        (loop (cons sexp done))))))
 
+;; TODO test-group fails if called before any test begin, since
+;; (test-runner-current) needs to be a test-runner (dead or not),
+;; but is initially bound to #f.
 (test-begin "tests")
-(for-each load-from-path files)
+(for fname in files
+     (format (current-error-port) "Running test ~a~%" fname)
+     (test-group
+      fname
+      (with-input-from-file (string-append here "/" fname)
+        (lambda ()
+          (let ((modules (read)))
+            (eval-in-sandbox
+             `(begin ,@(read-multiple))
+             #:module (make-sandbox-module
+                       (append modules
+                               '(((srfi srfi-64) test-assert test-equal test-error)
+                                 ((ice-9 ports) call-with-input-string)
+                                 ((guile) make-struct/no-tail)
+                                 )
+                               all-pure-bindings))))))))
 (test-end "tests")
+
+
diff --git a/tests/server.scm b/tests/server.scm
index 0821d85e..6388edb9 100644
--- a/tests/server.scm
+++ b/tests/server.scm
@@ -1,6 +1,6 @@
-(use-modules (server macro))
+(((server macro) parse-endpoint-string))
 
-(parse-endpoint-string "/static/:dir/:file")
+(test-assert (parse-endpoint-string "/static/:dir/:file"))
 ;; => "/static/([^/]+)/([^/]+)"
 ;; => (dir file)
 
diff --git a/tests/termios.scm b/tests/termios.scm
index 3d5ef9d1..22d8e242 100755
--- a/tests/termios.scm
+++ b/tests/termios.scm
@@ -7,15 +7,16 @@
 
 ;;; Code:
 
-(use-modules (terminal termios)
-             ((util) :select (mod!))
-             ((srfi srfi-60)
-              :renamer (lambda (symb)
-                         (case symb
-                           ((bitwise-ior) '||)
-                           ((bitwise-not) '~)
-                           ((bitwise-and) '&)
-                           (else symb)))))
+(((util) mod!)
+ ((vulgar termios)
+  make-termios copy-termios
+  lflag
+  tcgetattr! tcsetattr!
+  ECHO ICANON)
+ ((srfi srfi-60)
+  (bitwise-ior . ||)
+  (bitwise-not . ~)
+  (bitwise-and . &)))
 
 (define-syntax-rule (&= lvalue val)
   (mod! lvalue (lambda (v) (& v val))))