diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog index 0f4ff9d3c..77f682754 100644 --- a/test-suite/ChangeLog +++ b/test-suite/ChangeLog @@ -1,3 +1,28 @@ +2001-01-26 Dirk Herrmann + + This patch fixes things that I have broken with the last one :-( + + * guile-test (test-suite): New variable. + + (data-file-name): New function. Has the same purpose as the + former function data-file from lib.scm. Moved here in order to + have all file name handling at the same place. In contrast to the + former 'data-file function, it is not checked whether a file + exists. This allows to use this function also for file names of + files that are still to be created. + + (test-file-name): Use the global 'test-suite variable. + + (main): Initialize 'test-suite instead of a local variable. + + * lib.scm: Don't import paths any more. + + (data-file): Removed. Resurrected with a sligtly different + functionality as 'data-file-name' in guile-test. + + * r4rs.scm: For all references to temporary file, make use of + data-file-name. + 2001-01-26 Dirk Herrmann The following patch was sent by Thien-Thi Nguyen and a little bit diff --git a/test-suite/guile-test b/test-suite/guile-test index 20591a637..4cdbbb7b4 100755 --- a/test-suite/guile-test +++ b/test-suite/guile-test @@ -83,6 +83,10 @@ (ice-9 getopt-long) (ice-9 and-let*)) + +;;; Variables that will receive their actual values later. +(define test-suite default-test-suite) + ;;; General utilities, that probably should be in a library somewhere. @@ -121,12 +125,18 @@ ;;; The test driver. -(define (test-file-name test-dir test) - (in-vicinity test-dir test)) + +;;; Localizing test files and temporary data files relative to the +;;; test suite directory. + +(define (data-file-name filename) + (in-vicinity test-suite filename)) + +(define (test-file-name test) + (in-vicinity test-suite test)) ;;; Return a list of all the test files in the test tree. (define (enumerate-tests test-dir) - (let ((root-len (+ 1 (string-length test-dir))) (tests '())) (for-each-file (lambda (file) @@ -160,11 +170,12 @@ (if (opt 'debug #f) (enable-debug-mode)) - (let* ((test-suite - (or (opt 'test-suite #f) - (getenv "TEST_SUITE_DIR") - default-test-suite)) - (tests + (set! test-suite + (or (opt 'test-suite #f) + (getenv "TEST_SUITE_DIR") + default-test-suite)) + + (let* ((tests (let ((foo (opt '() '()))) (if (null? foo) (enumerate-tests test-suite) @@ -189,7 +200,7 @@ ;; Run the tests. (for-each (lambda (test) (with-test-prefix test - (load (test-file-name test-suite test)))) + (load (test-file-name test)))) tests) ;; Display the final counts, both to the user and in the log diff --git a/test-suite/lib.scm b/test-suite/lib.scm index fa730973b..87efcc034 100644 --- a/test-suite/lib.scm +++ b/test-suite/lib.scm @@ -16,8 +16,7 @@ ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, ;;;; Boston, MA 02111-1307 USA -(define-module (test-suite lib) - #:use-module (test-suite paths)) +(define-module (test-suite lib)) (export @@ -424,17 +423,6 @@ (set! default-reporter full-reporter) - -;;;; Helping test cases find their files - -;;; Returns FILENAME, relative to the directory the test suite data -;;; files were installed in, and makes sure the file exists. -(define (data-file filename) - (let ((f (in-vicinity datadir filename))) - (or (file-exists? f) - (error "Test suite data file does not exist: " f)) - f)) - ;;;; Detecting whether errors occur diff --git a/test-suite/tests/r4rs.test b/test-suite/tests/r4rs.test index c915b515c..28b86b095 100644 --- a/test-suite/tests/r4rs.test +++ b/test-suite/tests/r4rs.test @@ -547,14 +547,14 @@ (set! display-test-obj (list f.25 f-3.25));.3 often has such errors (~10^-13) (set! load-test-obj (list 'define 'foo (list 'quote write-test-obj))) (test #t call-with-output-file - "tmp3" + (data-file-name "tmp3") (lambda (test-file) (write-char #\; test-file) (display write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (output-port? test-file))) - (check-test-file "tmp3") + (check-test-file (data-file-name "tmp3")) (set! write-test-obj wto) (set! display-test-obj dto) (set! load-test-obj lto) @@ -935,8 +935,8 @@ (SECTION 6 10 1) (test #t input-port? (current-input-port)) (test #t output-port? (current-output-port)) -(test #t call-with-input-file (data-file "tests/r4rs.test") input-port?) -(define this-file (open-input-file (data-file "tests/r4rs.test"))) +(test #t call-with-input-file (data-file-name "r4rs.test") input-port?) +(define this-file (open-input-file (data-file-name "r4rs.test"))) (test #t input-port? this-file) (SECTION 6 10 2) (test #\; peek-char this-file) @@ -968,23 +968,23 @@ (define load-test-obj (list 'define 'foo (list 'quote write-test-obj))) (test #t call-with-output-file - "tmp1" + (data-file-name "tmp1") (lambda (test-file) (write-char #\; test-file) (display write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (output-port? test-file))) -(check-test-file "tmp1") +(check-test-file (data-file-name "tmp1")) -(define test-file (open-output-file "tmp2")) +(define test-file (open-output-file (data-file-name "tmp2"))) (write-char #\; test-file) (display write-test-obj test-file) (newline test-file) (write load-test-obj test-file) (test #t output-port? test-file) (close-output-port test-file) -(check-test-file "tmp2") +(check-test-file (data-file-name "tmp2")) (define (test-sc4) (SECTION 6 7) (test '(#\P #\space #\l) string->list "P l") @@ -997,7 +997,7 @@ (test '#(dididit dah) list->vector '(dididit dah)) (test '#() list->vector '()) (SECTION 6 10 4) - (load (data-file "tmp1")) + (load (data-file-name "tmp1")) (test write-test-obj 'load foo) (report-errs))