diff options
Diffstat (limited to 'libjava/classpath/testsuite/scheme/test.scm')
| -rw-r--r-- | libjava/classpath/testsuite/scheme/test.scm | 164 |
1 files changed, 0 insertions, 164 deletions
diff --git a/libjava/classpath/testsuite/scheme/test.scm b/libjava/classpath/testsuite/scheme/test.scm deleted file mode 100644 index 74b4b21..0000000 --- a/libjava/classpath/testsuite/scheme/test.scm +++ /dev/null @@ -1,164 +0,0 @@ -#!/usr/local/bin/guile -s -!# - -; Guile/JNI/JVM Testing Framework -; -; Copyright (c) 1998 Free Software Foundation, Inc. -; Written by Paul Fisher (rao@gnu.org) -; -; 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 of the License, 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 program; if not, write to the Free Software -; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, -; USA. - - -; log filenames -(define verbose-log-file "classpath.log") -(define summary-log-file "classpath.sum") - -; returns the number of times that ELEM appears in the toplevel of LS -(define count - (lambda (elem ls) - (letrec - ((count-it - (lambda (ls acc) - (cond - ((null? ls) acc) - ((equal? (car ls) elem) (count-it (cdr ls) (+ acc 1))) - (else (count-it (cdr ls) acc)))))) - (count-it ls 0)))) - -; returns a list of pairs containing an element of ELS along with the -; number of times that element appears in LS -(define build-result-count - (lambda (els ls) - (cond - ((null? els) '()) - (else (cons (cons (car els) (count (car els) ls)) - (build-result-count (cdr els) ls)))))) - -; soft port which sends output to both (current-output-port) and -; the verbose-log-port -(define screen-and-log-port - (make-soft-port - (vector - (lambda (c) - (cond - ((char=? c #\newline) - (newline (current-output-port)) - (newline verbose-log-port)) - (else - (write c (current-output-port)) - (write c verbose-log-port)))) - (lambda (s) - (display s (current-output-port)) - (display s verbose-log-port)) - (lambda () - (force-output (current-output-port)) - (force-output verbose-log-port)) - #f - #f) - "w")) - -; pretty prints the result of a single test -(define display-test-summary - (lambda (result port) - (let ((name (car result)) - (code (cadr result)) - (msg (caddr result))) - (display "Name : " port) - (display name port) - (newline port) - (display "Result : " port) - (display code port) - (newline port) - (display "Message : " port) - (if (= (string-length msg) 0) - (display "None" port) - (display msg port)) - (newline port) - (newline port)))) - -; status message -(define display-running - (lambda (class port) - (display "Running " port) - (display class port) - (display "..." port) - (newline port))) - -; runs the test named CLASS -(define run-test - (lambda (class) - (display-running class screen-and-log-port) - (force-output verbose-log-port) - (let ((result (test class))) - (display-test-summary result screen-and-log-port) - (write (cons class result) summary-log-port) - (newline summary-log-port) - (cadr result)))) - -; run each and every test. each test is read from PORT -; and delimited by a newline. returns a list of all test result codes -(define parse-input-file - (lambda (port) - (letrec - ((parse-line - (lambda (line) - (cond - ((eof-object? (car line)) '()) - ((= (string-length (car line)) 0) - (parse-line (read-line port 'split))) - (else (cons (run-test (car line)) - (parse-line - (read-line port 'split)))))))) - (parse-line (read-line port 'split))))) - -; pretty prints the result list -(define display-results - (lambda (results port) - (display "Summary information..." port) - (newline port) - (letrec ((display-results-l - (lambda (ls) - (cond - ((null? ls)) - (else - (let ((res (car ls))) - (display "# of " port) - (display (car res) port) - (display "'s " port) - (display (cdr res) port) - (newline port)) - (display-results-l (cdr ls))))))) - (display-results-l results)))) - -(if (batch-mode?) - (if (> (length (command-line)) 1) - (define input-port (open-input-file (cadr (command-line)))) - (error "filename listing tests to execute must be specified."))) - -; open up the log files -(define verbose-log-port (open verbose-log-file - (logior O_WRONLY O_CREAT O_TRUNC))) -(define summary-log-port (open summary-log-file - (logior O_WRONLY O_CREAT O_TRUNC))) - -; redirect stderr to the verbose log -(dup verbose-log-port 2) - -; run the tests, and build the result table, and display the results -(display-results (build-result-count - '(PASS XPASS FAIL XPAIL UNRESOLVED - UNSUPPORTED UNTESTED ERROR) - (parse-input-file input-port)) screen-and-log-port) |