summaryrefslogtreecommitdiff
path: root/test-suite/guile-test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/guile-test')
-rwxr-xr-xtest-suite/guile-test162
1 files changed, 0 insertions, 162 deletions
diff --git a/test-suite/guile-test b/test-suite/guile-test
deleted file mode 100755
index f46bcae62..000000000
--- a/test-suite/guile-test
+++ /dev/null
@@ -1,162 +0,0 @@
-#!/usr/local/bin/guile \
--e main -s
-!#
-
-;;;; guile-test --- run the Guile test suite
-;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
-;;;;
-;;;; Copyright (C) 1999 Free Software Foundation, Inc.
-;;;;
-;;;; This program is free software; you can redistribute it and/or modify
-;;;; it under the terms of the GNU General Public License as published by
-;;;; the Free Software Foundation; either version 2, or (at your option)
-;;;; any later version.
-;;;;
-;;;; This program is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;;;; GNU General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU General Public License
-;;;; along with this software; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
-;;;; Boston, MA 02111-1307 USA
-
-
-
-;;;; Usage: guile-test [--log-file LOG] [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'.
-;;;;
-;;;; 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.
-;;;;
-;;;; If present, the `--log-file LOG' option tells `guile-test' to put
-;;;; the log output in a file named LOG.
-;;;;
-;;;; 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.
-;;;;
-;;;; 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
-;;;; the log file, that would be great. At the moment, all the tests
-;;;; I care about are in the test directory, though.
-;;;;
-;;;; It would be nice if you could specify the Guile interpreter you
-;;;; want to test on the command line. As it stands, if you want to
-;;;; change which Guile interpreter you're testing, you need to edit
-;;;; the #! line at the top of this file, which is stupid.
-
-(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.
-
-;;; 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
-;;; symlinks.
-(define (for-each-file f root)
-
- ;; A "hard directory" is a path that denotes a directory and is not a
- ;; symlink.
- (define (file-is-hard-directory? filename)
- (eq? (stat:type (lstat filename)) 'directory))
-
- (let visit ((root root))
- (let ((should-recur (f root)))
- (if (and should-recur (file-is-hard-directory? root))
- (let ((dir (opendir root)))
- (let loop ()
- (let ((entry (readdir dir)))
- (cond
- ((eof-object? entry) #f)
- ((or (string=? entry ".")
- (string=? entry ".."))
- (loop))
- (else
- (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))
-
-;;; Return a list of all the test files in the test tree.
-(define (enumerate-tests)
- (let ((root-len (+ 1 (string-length test-root)))
- (tests '()))
- (for-each-file (lambda (file)
- (if (has-suffix? file ".test")
- (let ((short-name
- (substring file root-len)))
- (set! tests (cons short-name tests))))
- #t)
- test-root)
-
- ;; for-each-file presents the files in whatever order it finds
- ;; them in the directory. We sort them here, so they'll always
- ;; appear in the same order. This makes it easier to compare test
- ;; log files mechanically.
- (sort tests string<?)))
-
-(define (main args)
- (let ((options (getopt-long args
- `((log-file (single-char #\l)
- (value #t))))))
- (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))))
-
- ;; Open the log file.
- (let ((log-port (open-output-file log-file)))
-
- ;; Register some reporters.
- (let ((counter (make-count-reporter)))
- (register-reporter (car counter))
- (register-reporter (make-log-reporter log-port))
- (register-reporter user-reporter)
-
- ;; Run the tests.
- (for-each (lambda (test)
- (with-test-prefix test
- (catch-test-errors
- (load (test-file-name test)))))
- tests)
-
- ;; Display the final counts, both to the user and in the log
- ;; file.
- (let ((counts ((cadr counter))))
- (print-counts counts)
- (print-counts counts log-port))
-
- (close-port log-port))))))
-
-
-;;; Local Variables:
-;;; mode: scheme
-;;; End: