diff options
Diffstat (limited to 'libjava/classpath/testsuite/scheme/test.scm')
| -rw-r--r-- | libjava/classpath/testsuite/scheme/test.scm | 164 |
1 files changed, 164 insertions, 0 deletions
diff --git a/libjava/classpath/testsuite/scheme/test.scm b/libjava/classpath/testsuite/scheme/test.scm new file mode 100644 index 0000000..74b4b21 --- /dev/null +++ b/libjava/classpath/testsuite/scheme/test.scm @@ -0,0 +1,164 @@ +#!/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) |