* Added Thien-Thi Nguyen's patch to support "make check".

8 files changed, 119 insertions, 34 deletions

diff --git a/ChangeLog b/ChangeLog
index e5cd22a1c..7214bff2a 100644
--- a/ChangeLog
+++ b/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>
 
 	* acconfig.h:  Removed bogus #ifndef.  Thanks to Lars J. Aas.
diff --git a/Makefile.am b/Makefile.am
index 847e90e33..76b1af194 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -25,5 +25,7 @@ include_HEADERS = libguile.h
 
 EXTRA_DIST = qthreads.m4 HACKING GUILE-VERSION ANON-CVS SNAPSHOTS
 
+TESTS = check-guile
+
 # The rule will cd to $(top_srcdir).
 ACLOCAL = ./guile-aclocal.sh
diff --git a/THANKS b/THANKS
index 14825bf91..84faf45ac 100644
--- a/THANKS
+++ b/THANKS
@@ -27,6 +27,7 @@ For fixes or providing information which led to a fix:
        Ralf Mattes
       Shuji Narazaki
     Nicolas Neuss
+  Thien-Thi Nguyen
     Han-Wen Nienhuys
       David Pirotte
      Julian Satchell
diff --git a/configure.in b/configure.in
index 39f848d3c..5705f5b01 100644
--- a/configure.in
+++ b/configure.in
@@ -507,7 +507,11 @@ AC_SUBST(AWK)
 AC_SUBST(LIBLOBJS)
 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 comment-start: "dnl "
diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index 3a6c32214..0f4ff9d3c 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -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>
 
 	* tests/ports.test: include (ice-9 rdelim) module.
diff --git a/test-suite/README b/test-suite/README
index d13e76c51..116869e17 100644
--- a/test-suite/README
+++ b/test-suite/README
@@ -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
 getopt-long) modules, which were added to Guile around then.
 
-To run the test suite, you'll need to:
-- edit the path to the guile interpreter in `guile-test', and 
-- 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.
+For information about how to run the test suite, read the usage
+instructions in the comments at the top of the guile-test script.
 
 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
diff --git a/test-suite/guile-test b/test-suite/guile-test
index faa9a1c13..20591a637 100755
--- a/test-suite/guile-test
+++ b/test-suite/guile-test
@@ -1,4 +1,4 @@
-#!/usr/local/bin/guile \
+#!/home/dirk/bin/guile \
 -e main -s
 !#
 
@@ -23,34 +23,48 @@
 ;;;; Boston, MA 02111-1307 USA
 
 
-
-;;;; Usage: guile-test [--log-file LOG] [TEST ...]
+;;;; Usage: [guile -e main -s] guile-test [OPTIONS] [TEST ...]
 ;;;;
 ;;;; Run tests from the Guile test suite.  Report failures and
 ;;;; unexpected passes to the standard output, along with a summary of
 ;;;; 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
 ;;;; files whose names end in `.test'.  (It assumes they contain
 ;;;; Scheme code.)  However, you can have it execute specific tests by
 ;;;; 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
 ;;;; the log output in a file named LOG.
 ;;;;
+;;;; If present, the '--debug' option will enable a debugging mode.
+;;;;
+;;;;
 ;;;; Installation:
 ;;;;
-;;;; Change the #! line at the top of this script to point at the
-;;;; Guile interpreter you want to test.  Edit `test-suite/paths.scm'
-;;;; so that datadir points to the parent directory of the `tests' tree.
+;;;; If you change the #! line at the top of this script to point at
+;;;; the Guile interpreter you want to test, you can call this script
+;;;; 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:
 ;;;;
 ;;;; At the moment, due to a simple-minded implementation, test files
 ;;;; 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
-;;;; 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
 ;;;; I care about are in the test directory, though.
 ;;;;
@@ -59,14 +73,25 @@
 ;;;; change which Guile interpreter you're testing, you need to edit
 ;;;; 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)
-	     (test-suite paths)
 	     (ice-9 getopt-long)
 	     (ice-9 and-let*))
 
 
 ;;; 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
 ;;; each file in the tree, including ROOT itself.  For a subdirectory
 ;;; SUB, if (F SUB) is true, we recurse into SUB.  Do not follow
@@ -93,18 +118,16 @@
 		  (visit (string-append root "/" entry))
 		  (loop))))))))))
 
-
 
 ;;; The test driver.
 
-(define test-root (in-vicinity datadir "tests"))
-
-(define (test-file-name test)
-  (in-vicinity test-root test))
+(define (test-file-name test-dir test)
+  (in-vicinity test-dir test))
 
 ;;; Return a list of all the test files in the test tree.
-(define (enumerate-tests)
-  (let ((root-len (+ 1 (string-length test-root)))
+(define (enumerate-tests test-dir)
+  
+  (let ((root-len (+ 1 (string-length test-dir)))
 	(tests '()))
     (for-each-file (lambda (file)
 		     (if (has-suffix? file ".test")
@@ -112,7 +135,7 @@
 				(substring file root-len)))
 			   (set! tests (cons short-name tests))))
 		     #t)
-		   test-root)
+		   test-dir)
 
     ;; for-each-file presents the files in whatever order it finds
     ;; them in the directory.  We sort them here, so they'll always
@@ -122,29 +145,51 @@
 
 (define (main args)
   (let ((options (getopt-long args
-			      `((log-file (single-char #\l)
-					  (value #t))))))
+			      `((test-suite 
+				 (single-char #\t)
+				 (value #t))
+				(log-file 
+				 (single-char #\l)
+				 (value #t))
+				(debug 
+				 (single-char #\d))))))
     (define (opt tag default)
       (let ((pair (assq tag options)))
 	(if pair (cdr pair) default)))
-    (let ((log-file (opt 'log-file "guile.log"))
-	  (tests (let ((foo (opt '() '())))
-		   (if (null? foo) (enumerate-tests)
-		       foo))))
+
+    (if (opt 'debug #f)
+	(enable-debug-mode))
+
+    (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.
       (let ((log-port (open-output-file log-file)))
 
 	;; Register some reporters.
-	(let ((counter (make-count-reporter)))
+	(let ((global-pass #t)
+	      (counter (make-count-reporter)))
 	  (register-reporter (car counter))
 	  (register-reporter (make-log-reporter log-port))
 	  (register-reporter user-reporter)
+	  (register-reporter (lambda results
+			       (case (car results)
+				 ((fail upass unresolved error)
+				  (set! global-pass #f)))))
 
 	  ;; Run the tests.
 	  (for-each (lambda (test)
 		      (with-test-prefix test
-			(load (test-file-name test))))
+			(load (test-file-name test-suite test))))
 		    tests)
 
 	  ;; Display the final counts, both to the user and in the log
@@ -153,7 +198,8 @@
 	    (print-counts counts)
 	    (print-counts counts log-port))
 
-	  (close-port log-port))))))
+	  (close-port log-port)
+	  (quit global-pass))))))
 
 
 ;;; Local Variables:
diff --git a/test-suite/paths.scm b/test-suite/paths.scm
deleted file mode 100644
index e69de29bb..000000000
--- a/test-suite/paths.scm
+++ /dev/null