From c286ee7d410950152177d209c20a843d4a3f8c26 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Wed, 3 Apr 2019 22:21:20 +0200
Subject: Update tests.

---
 tests/let.scm                  | 10 +------
 tests/prop.scm                 | 16 +++--------
 tests/recurring.scm            | 10 ++-----
 tests/run-tests.scm            | 37 +++++++++++++++++++++++++
 tests/stream-time.scm.disabled | 63 ++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 107 insertions(+), 29 deletions(-)
 mode change 100755 => 100644 tests/let.scm
 mode change 100755 => 100644 tests/prop.scm
 mode change 100755 => 100644 tests/recurring.scm
 create mode 100755 tests/run-tests.scm
 create mode 100644 tests/stream-time.scm.disabled

diff --git a/tests/let.scm b/tests/let.scm
old mode 100755
new mode 100644
index c2779657..21b23754
--- a/tests/let.scm
+++ b/tests/let.scm
@@ -1,12 +1,4 @@
-#!/usr/bin/guile \
--s
-!#
-
-(add-to-load-path (string-append (dirname (dirname (current-filename)))
-                                 "/module"))
-
-(use-modules (srfi srfi-64)
-             (util))
+(use-modules (util))
 
 (test-begin "let")
 
diff --git a/tests/prop.scm b/tests/prop.scm
old mode 100755
new mode 100644
index 649e30e4..d63703cd
--- a/tests/prop.scm
+++ b/tests/prop.scm
@@ -1,16 +1,8 @@
-#!/usr/bin/guile -s
-!#
+(use-modules (vcalendar))
 
-(define *dir* (dirname (dirname (current-filename))))
-(define (path subdir)
-  (string-append *dir* "/" subdir))
-
-(add-to-load-path (path "module"))
-
-(use-modules (srfi srfi-64)
-             (vcalendar))
-
-(define v (make-vcomponent (path "testdata/prop.ics")))
+(define v (make-vcomponent
+           (string-append (getenv "TESTPATH")
+                          "/prop.ics")))
 
 (test-begin "Proporty test")
 (test-equal (prop v 'KEY 'A) '(("1")))
diff --git a/tests/recurring.scm b/tests/recurring.scm
old mode 100755
new mode 100644
index 1fcef974..ebf40cb1
--- a/tests/recurring.scm
+++ b/tests/recurring.scm
@@ -1,13 +1,7 @@
-#!/usr/bin/guile -s
-!#
-
-(add-to-load-path (string-append (dirname (dirname (current-filename))) "/module"))
-
 (use-modules (srfi srfi-1)
              (srfi srfi-19)
              (srfi srfi-19 util)
              (srfi srfi-41)
-             (srfi srfi-64)             ; Testisg
 
              (util)
              (vcalendar)
@@ -20,8 +14,8 @@
           (time->string (attr ev "DTEND"))))
 
 (define (tcal str)
-  (format #f "~a/testdata/recurrence/~a"
-          (dirname (dirname (current-filename)))
+  (format #f "~a/recurrence/~a"
+          (getenv "TESTPATH")
           str))
 
 (test-begin "recurrence test")
diff --git a/tests/run-tests.scm b/tests/run-tests.scm
new file mode 100755
index 00000000..e68f058b
--- /dev/null
+++ b/tests/run-tests.scm
@@ -0,0 +1,37 @@
+#!/usr/bin/guile \
+-s
+!#
+
+(eval-when (compile load)
+ (define here (dirname (current-filename))))
+
+(add-to-load-path (format #f "~a/module"
+                          (dirname here)))
+
+
+(use-modules (ice-9 ftw)
+             (ice-9 sandbox))
+
+(define files
+  (scandir here
+           (lambda (name)
+             (and (< 2 (string-length name))
+                  (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)
+(for-each load-from-path files)
+
+;; Final test, triggers output
+(test-begin "metatest")
+(test-assert #t)
+(test-expect-fail 1)
+(test-assert #f)
+(test-end "metatest")
diff --git a/tests/stream-time.scm.disabled b/tests/stream-time.scm.disabled
new file mode 100644
index 00000000..d604d0f4
--- /dev/null
+++ b/tests/stream-time.scm.disabled
@@ -0,0 +1,63 @@
+;;; Commentary:
+
+;; This is not really a test of calparse, but just some benchmarks on Guile's
+;; built in SRFI-41 (stream) implementation. While running interactively the code
+;; @lisp
+;; (stream 1 2 3)
+;; @end lisp
+;; is extremely slow (0.5s). The problem however seems to go away during
+;; compilation. Note however that
+;; @lisp
+;; (list->stream '(1 2 3))
+;; @end lisp
+;; is fast in both cases.
+
+;;; Code:
+
+(use-modules (srfi srfi-19)             ; Time
+             (srfi srfi-41)             ; Streams
+             (srfi srfi-64)             ; Tests
+             (srfi srfi-71)             ; let-multiple
+             (ice-9 format))
+
+;;; TODO use statprof insteadd
+
+(define (timed thunk)
+  "Returns two values, @var{result} and @var{time ellapsed}."
+ (let ((start-time (current-time time-process)))
+   (let ((result (thunk)))
+     (let ((end-time (current-time time-process)))
+       (values result
+               (time-difference end-time start-time))))))
+
+(define-syntax-rule (with-printed-time port expr ...)
+  (let ((result duration (timed (lambda () expr ...))))
+    (format port "~6f :: ~a~%"
+            (+ (time-second duration)
+               (/ (time-nanosecond duration) 1e5))
+            (quote expr ...))))
+
+(with-printed-time #t (stream 1 2 3 4 5))
+(with-printed-time #t (list->stream '(1 2 3 4 5)))
+(with-printed-time #t (stream->list (list->stream '(1 2 3 4 5))))
+(with-printed-time
+ #t (stream-cons
+     1 (stream-cons
+        2 (stream-cons
+           3 (stream-cons
+              4 (stream-cons
+                 5 stream-null))))))
+
+(display (make-string 60 #\-)) (newline)
+
+(eval-when (load)
+  (with-printed-time #t (stream 1 2 3 4 5))
+  (with-printed-time #t (list->stream '(1 2 3 4 5)))
+  (with-printed-time #t (stream->list (list->stream '(1 2 3 4 5))))
+  (with-printed-time
+   #t (stream-cons
+       1 (stream-cons
+          2 (stream-cons
+             3 (stream-cons
+                4 (stream-cons
+                   5 stream-null)))))))
-- 
cgit v1.2.3