mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
* Added Thien-Thi Nguyen's patch to support "make check".
This commit is contained in:
parent
2f2b390c83
commit
1ff7abbe3f
8 changed files with 119 additions and 34 deletions
10
ChangeLog
10
ChangeLog
|
@ -1,3 +1,13 @@
|
||||||
|
2001-01-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
|
The following patch was sent by Thien-Thi Nguyen.
|
||||||
|
|
||||||
|
* check-guile.in: New file.
|
||||||
|
|
||||||
|
* Makefile.am: Add TESTS rule.
|
||||||
|
|
||||||
|
* configure.in: Add support for "make check".
|
||||||
|
|
||||||
2000-11-21 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
2000-11-21 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
* acconfig.h: Removed bogus #ifndef. Thanks to Lars J. Aas.
|
* acconfig.h: Removed bogus #ifndef. Thanks to Lars J. Aas.
|
||||||
|
|
|
@ -25,5 +25,7 @@ include_HEADERS = libguile.h
|
||||||
|
|
||||||
EXTRA_DIST = qthreads.m4 HACKING GUILE-VERSION ANON-CVS SNAPSHOTS
|
EXTRA_DIST = qthreads.m4 HACKING GUILE-VERSION ANON-CVS SNAPSHOTS
|
||||||
|
|
||||||
|
TESTS = check-guile
|
||||||
|
|
||||||
# The rule will cd to $(top_srcdir).
|
# The rule will cd to $(top_srcdir).
|
||||||
ACLOCAL = ./guile-aclocal.sh
|
ACLOCAL = ./guile-aclocal.sh
|
||||||
|
|
1
THANKS
1
THANKS
|
@ -27,6 +27,7 @@ For fixes or providing information which led to a fix:
|
||||||
Ralf Mattes
|
Ralf Mattes
|
||||||
Shuji Narazaki
|
Shuji Narazaki
|
||||||
Nicolas Neuss
|
Nicolas Neuss
|
||||||
|
Thien-Thi Nguyen
|
||||||
Han-Wen Nienhuys
|
Han-Wen Nienhuys
|
||||||
David Pirotte
|
David Pirotte
|
||||||
Julian Satchell
|
Julian Satchell
|
||||||
|
|
|
@ -507,7 +507,11 @@ AC_SUBST(AWK)
|
||||||
AC_SUBST(LIBLOBJS)
|
AC_SUBST(LIBLOBJS)
|
||||||
AC_SUBST(EXTRA_DOT_DOC_FILES)
|
AC_SUBST(EXTRA_DOT_DOC_FILES)
|
||||||
|
|
||||||
AC_OUTPUT([Makefile libguile/Makefile libguile/guile-snarf libguile/guile-doc-snarf libguile/guile-func-name-check libguile/guile-snarf.awk libguile/versiondat.h ice-9/Makefile oop/Makefile oop/goops/Makefile qt/Makefile qt/qt.h qt/md/Makefile qt/time/Makefile guile-config/Makefile doc/Makefile], [chmod +x libguile/guile-snarf libguile/guile-doc-snarf libguile/guile-func-name-check])
|
# Support for "make check"
|
||||||
|
test_suite_dir="`(cd $srcdir ; pwd)`/test-suite"
|
||||||
|
AC_SUBST(test_suite_dir)
|
||||||
|
|
||||||
|
AC_OUTPUT([Makefile libguile/Makefile libguile/guile-snarf libguile/guile-doc-snarf libguile/guile-func-name-check libguile/guile-snarf.awk libguile/versiondat.h ice-9/Makefile oop/Makefile oop/goops/Makefile qt/Makefile qt/qt.h qt/md/Makefile qt/time/Makefile guile-config/Makefile doc/Makefile check-guile], [chmod +x libguile/guile-snarf libguile/guile-doc-snarf libguile/guile-func-name-check check-guile])
|
||||||
|
|
||||||
dnl Local Variables:
|
dnl Local Variables:
|
||||||
dnl comment-start: "dnl "
|
dnl comment-start: "dnl "
|
||||||
|
|
|
@ -1,3 +1,30 @@
|
||||||
|
2001-01-26 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
|
The following patch was sent by Thien-Thi Nguyen and a little bit
|
||||||
|
modified by me.
|
||||||
|
|
||||||
|
* guile-test: Usage and installation comments improved. Added
|
||||||
|
support for --test-suite and --debug command line options.
|
||||||
|
|
||||||
|
(default-test-suite): Added to allow for simplified
|
||||||
|
configurability. No need to load the paths file any more.
|
||||||
|
|
||||||
|
(enable-debug-mode): New function. Will be called when the
|
||||||
|
--debug command line option is given.
|
||||||
|
|
||||||
|
(test-root): Removed. The test directory has to be fully given.
|
||||||
|
This allows for arbitrarily named test directories.
|
||||||
|
|
||||||
|
(test-file-name, enumerate-tets): Take the test directory as a
|
||||||
|
paramter instead of using the global variable 'test-root'.
|
||||||
|
|
||||||
|
(main): Handle the new command line options. Return an exit code
|
||||||
|
depending on whether all tests came out as expected.
|
||||||
|
|
||||||
|
* README: Updated.
|
||||||
|
|
||||||
|
* paths.scm: Removed.
|
||||||
|
|
||||||
2001-01-24 Gary Houston <ghouston@arglist.com>
|
2001-01-24 Gary Houston <ghouston@arglist.com>
|
||||||
|
|
||||||
* tests/ports.test: include (ice-9 rdelim) module.
|
* tests/ports.test: include (ice-9 rdelim) module.
|
||||||
|
|
|
@ -5,13 +5,8 @@ To run these tests, you will need a version of Guile more recent than
|
||||||
15 Feb 1999 --- the tests use the (ice-9 and-let*) and (ice-9
|
15 Feb 1999 --- the tests use the (ice-9 and-let*) and (ice-9
|
||||||
getopt-long) modules, which were added to Guile around then.
|
getopt-long) modules, which were added to Guile around then.
|
||||||
|
|
||||||
To run the test suite, you'll need to:
|
For information about how to run the test suite, read the usage
|
||||||
- edit the path to the guile interpreter in `guile-test', and
|
instructions in the comments at the top of the guile-test script.
|
||||||
- edit the paths in `paths.scm', so `guile-test' can find the test
|
|
||||||
scripts.
|
|
||||||
|
|
||||||
Once that's done, you can just run the `guile-test' script. That
|
|
||||||
script has usage instructions in the comments at the top.
|
|
||||||
|
|
||||||
You can reference the file `lib.scm' from your own code as the module
|
You can reference the file `lib.scm' from your own code as the module
|
||||||
(test-suite lib); it also has comments at the top and before each
|
(test-suite lib); it also has comments at the top and before each
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
#!/usr/local/bin/guile \
|
#!/home/dirk/bin/guile \
|
||||||
-e main -s
|
-e main -s
|
||||||
!#
|
!#
|
||||||
|
|
||||||
|
@ -23,34 +23,48 @@
|
||||||
;;;; Boston, MA 02111-1307 USA
|
;;;; Boston, MA 02111-1307 USA
|
||||||
|
|
||||||
|
|
||||||
|
;;;; Usage: [guile -e main -s] guile-test [OPTIONS] [TEST ...]
|
||||||
;;;; Usage: guile-test [--log-file LOG] [TEST ...]
|
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Run tests from the Guile test suite. Report failures and
|
;;;; Run tests from the Guile test suite. Report failures and
|
||||||
;;;; unexpected passes to the standard output, along with a summary of
|
;;;; unexpected passes to the standard output, along with a summary of
|
||||||
;;;; all the results. Record each reported test outcome in the log
|
;;;; all the results. Record each reported test outcome in the log
|
||||||
;;;; file, `guile.log'.
|
;;;; file, `guile.log'. The exit status is #f if any of the tests
|
||||||
|
;;;; fail or pass unexpectedly.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Normally, guile-test scans the test directory, and executes all
|
;;;; Normally, guile-test scans the test directory, and executes all
|
||||||
;;;; files whose names end in `.test'. (It assumes they contain
|
;;;; files whose names end in `.test'. (It assumes they contain
|
||||||
;;;; Scheme code.) However, you can have it execute specific tests by
|
;;;; Scheme code.) However, you can have it execute specific tests by
|
||||||
;;;; listing their filenames on the command line.
|
;;;; listing their filenames on the command line.
|
||||||
;;;;
|
;;;;
|
||||||
|
;;;; The option '--test-suite' can be given to specify the test
|
||||||
|
;;;; directory. If no such option is given, the test directory is
|
||||||
|
;;;; taken from the environment variable TEST_SUITE_DIR (if defined),
|
||||||
|
;;;; otherwise a default directory that is hardcoded in this file is
|
||||||
|
;;;; used (see "Installation" below).
|
||||||
|
;;;;
|
||||||
;;;; If present, the `--log-file LOG' option tells `guile-test' to put
|
;;;; If present, the `--log-file LOG' option tells `guile-test' to put
|
||||||
;;;; the log output in a file named LOG.
|
;;;; the log output in a file named LOG.
|
||||||
;;;;
|
;;;;
|
||||||
|
;;;; If present, the '--debug' option will enable a debugging mode.
|
||||||
|
;;;;
|
||||||
|
;;;;
|
||||||
;;;; Installation:
|
;;;; Installation:
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Change the #! line at the top of this script to point at the
|
;;;; If you change the #! line at the top of this script to point at
|
||||||
;;;; Guile interpreter you want to test. Edit `test-suite/paths.scm'
|
;;;; the Guile interpreter you want to test, you can call this script
|
||||||
;;;; so that datadir points to the parent directory of the `tests' tree.
|
;;;; as an executable instead of having to pass it as a parameter to
|
||||||
|
;;;; guile via "guile -e main -s guile-test". Further, you can edit
|
||||||
|
;;;; the definition of default-test-suite to point to the parent
|
||||||
|
;;;; directory of the `tests' tree, which makes it unnecessary to set
|
||||||
|
;;;; the environment variable `TEST_SUITE_DIR'.
|
||||||
|
;;;;
|
||||||
;;;;
|
;;;;
|
||||||
;;;; Shortcomings:
|
;;;; Shortcomings:
|
||||||
;;;;
|
;;;;
|
||||||
;;;; At the moment, due to a simple-minded implementation, test files
|
;;;; At the moment, due to a simple-minded implementation, test files
|
||||||
;;;; must live in the test directory, and you must specify their names
|
;;;; must live in the test directory, and you must specify their names
|
||||||
;;;; relative to the top of the test directory. If you want to send
|
;;;; relative to the top of the test directory. If you want to send
|
||||||
;;;; me a patche that fixes this, but still leaves sane test names in
|
;;;; me a patch that fixes this, but still leaves sane test names in
|
||||||
;;;; the log file, that would be great. At the moment, all the tests
|
;;;; the log file, that would be great. At the moment, all the tests
|
||||||
;;;; I care about are in the test directory, though.
|
;;;; I care about are in the test directory, though.
|
||||||
;;;;
|
;;;;
|
||||||
|
@ -59,14 +73,25 @@
|
||||||
;;;; change which Guile interpreter you're testing, you need to edit
|
;;;; change which Guile interpreter you're testing, you need to edit
|
||||||
;;;; the #! line at the top of this file, which is stupid.
|
;;;; the #! line at the top of this file, which is stupid.
|
||||||
|
|
||||||
|
|
||||||
|
;;; User configurable settings:
|
||||||
|
(define default-test-suite
|
||||||
|
(string-append (getenv "HOME") "/guile-core/test-suite"))
|
||||||
|
|
||||||
|
|
||||||
(use-modules (test-suite lib)
|
(use-modules (test-suite lib)
|
||||||
(test-suite paths)
|
|
||||||
(ice-9 getopt-long)
|
(ice-9 getopt-long)
|
||||||
(ice-9 and-let*))
|
(ice-9 and-let*))
|
||||||
|
|
||||||
|
|
||||||
;;; General utilities, that probably should be in a library somewhere.
|
;;; General utilities, that probably should be in a library somewhere.
|
||||||
|
|
||||||
|
;;; Enable debugging
|
||||||
|
(define (enable-debug-mode)
|
||||||
|
(write-line %load-path)
|
||||||
|
(set! %load-verbosely #t)
|
||||||
|
(debug-enable 'backtrace 'debug))
|
||||||
|
|
||||||
;;; Traverse the directory tree at ROOT, applying F to the name of
|
;;; Traverse the directory tree at ROOT, applying F to the name of
|
||||||
;;; each file in the tree, including ROOT itself. For a subdirectory
|
;;; each file in the tree, including ROOT itself. For a subdirectory
|
||||||
;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow
|
;;; SUB, if (F SUB) is true, we recurse into SUB. Do not follow
|
||||||
|
@ -93,18 +118,16 @@
|
||||||
(visit (string-append root "/" entry))
|
(visit (string-append root "/" entry))
|
||||||
(loop))))))))))
|
(loop))))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; The test driver.
|
;;; The test driver.
|
||||||
|
|
||||||
(define test-root (in-vicinity datadir "tests"))
|
(define (test-file-name test-dir test)
|
||||||
|
(in-vicinity test-dir test))
|
||||||
(define (test-file-name test)
|
|
||||||
(in-vicinity test-root test))
|
|
||||||
|
|
||||||
;;; Return a list of all the test files in the test tree.
|
;;; Return a list of all the test files in the test tree.
|
||||||
(define (enumerate-tests)
|
(define (enumerate-tests test-dir)
|
||||||
(let ((root-len (+ 1 (string-length test-root)))
|
|
||||||
|
(let ((root-len (+ 1 (string-length test-dir)))
|
||||||
(tests '()))
|
(tests '()))
|
||||||
(for-each-file (lambda (file)
|
(for-each-file (lambda (file)
|
||||||
(if (has-suffix? file ".test")
|
(if (has-suffix? file ".test")
|
||||||
|
@ -112,7 +135,7 @@
|
||||||
(substring file root-len)))
|
(substring file root-len)))
|
||||||
(set! tests (cons short-name tests))))
|
(set! tests (cons short-name tests))))
|
||||||
#t)
|
#t)
|
||||||
test-root)
|
test-dir)
|
||||||
|
|
||||||
;; for-each-file presents the files in whatever order it finds
|
;; for-each-file presents the files in whatever order it finds
|
||||||
;; them in the directory. We sort them here, so they'll always
|
;; them in the directory. We sort them here, so they'll always
|
||||||
|
@ -122,29 +145,51 @@
|
||||||
|
|
||||||
(define (main args)
|
(define (main args)
|
||||||
(let ((options (getopt-long args
|
(let ((options (getopt-long args
|
||||||
`((log-file (single-char #\l)
|
`((test-suite
|
||||||
(value #t))))))
|
(single-char #\t)
|
||||||
|
(value #t))
|
||||||
|
(log-file
|
||||||
|
(single-char #\l)
|
||||||
|
(value #t))
|
||||||
|
(debug
|
||||||
|
(single-char #\d))))))
|
||||||
(define (opt tag default)
|
(define (opt tag default)
|
||||||
(let ((pair (assq tag options)))
|
(let ((pair (assq tag options)))
|
||||||
(if pair (cdr pair) default)))
|
(if pair (cdr pair) default)))
|
||||||
(let ((log-file (opt 'log-file "guile.log"))
|
|
||||||
(tests (let ((foo (opt '() '())))
|
(if (opt 'debug #f)
|
||||||
(if (null? foo) (enumerate-tests)
|
(enable-debug-mode))
|
||||||
foo))))
|
|
||||||
|
(let* ((test-suite
|
||||||
|
(or (opt 'test-suite #f)
|
||||||
|
(getenv "TEST_SUITE_DIR")
|
||||||
|
default-test-suite))
|
||||||
|
(tests
|
||||||
|
(let ((foo (opt '() '())))
|
||||||
|
(if (null? foo)
|
||||||
|
(enumerate-tests test-suite)
|
||||||
|
foo)))
|
||||||
|
(log-file
|
||||||
|
(opt 'log-file "guile.log")))
|
||||||
|
|
||||||
;; Open the log file.
|
;; Open the log file.
|
||||||
(let ((log-port (open-output-file log-file)))
|
(let ((log-port (open-output-file log-file)))
|
||||||
|
|
||||||
;; Register some reporters.
|
;; Register some reporters.
|
||||||
(let ((counter (make-count-reporter)))
|
(let ((global-pass #t)
|
||||||
|
(counter (make-count-reporter)))
|
||||||
(register-reporter (car counter))
|
(register-reporter (car counter))
|
||||||
(register-reporter (make-log-reporter log-port))
|
(register-reporter (make-log-reporter log-port))
|
||||||
(register-reporter user-reporter)
|
(register-reporter user-reporter)
|
||||||
|
(register-reporter (lambda results
|
||||||
|
(case (car results)
|
||||||
|
((fail upass unresolved error)
|
||||||
|
(set! global-pass #f)))))
|
||||||
|
|
||||||
;; Run the tests.
|
;; Run the tests.
|
||||||
(for-each (lambda (test)
|
(for-each (lambda (test)
|
||||||
(with-test-prefix test
|
(with-test-prefix test
|
||||||
(load (test-file-name test))))
|
(load (test-file-name test-suite test))))
|
||||||
tests)
|
tests)
|
||||||
|
|
||||||
;; Display the final counts, both to the user and in the log
|
;; Display the final counts, both to the user and in the log
|
||||||
|
@ -153,7 +198,8 @@
|
||||||
(print-counts counts)
|
(print-counts counts)
|
||||||
(print-counts counts log-port))
|
(print-counts counts log-port))
|
||||||
|
|
||||||
(close-port log-port))))))
|
(close-port log-port)
|
||||||
|
(quit global-pass))))))
|
||||||
|
|
||||||
|
|
||||||
;;; Local Variables:
|
;;; Local Variables:
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue