1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-09 13:30:26 +02:00

* Fixed things that I had broken with the last patch :-(

This commit is contained in:
Dirk Herrmann 2001-01-26 16:49:28 +00:00
parent 8992c8a2ef
commit efb07c899c
4 changed files with 55 additions and 31 deletions

View file

@ -1,3 +1,28 @@
2001-01-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
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 <D.Herrmann@tu-bs.de>
The following patch was sent by Thien-Thi Nguyen and a little bit

View file

@ -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
(set! test-suite
(or (opt 'test-suite #f)
(getenv "TEST_SUITE_DIR")
default-test-suite))
(tests
(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

View file

@ -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

View file

@ -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))