From b6d12e309b207c25de7873f658aa0f88ea77080c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 30 Dec 2019 02:11:38 +0100 Subject: Reworked tests. --- tests/run-tests.scm | 39 +++++++++++++++++++++++++++++++++------ 1 file changed, 33 insertions(+), 6 deletions(-) (limited to 'tests/run-tests.scm') 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") + + -- cgit v1.2.3