1 #!/usr/local/bin/guile -s
4 ; Guile/JNI/JVM Testing Framework
6 ; Copyright (c) 1998 Free Software Foundation, Inc.
7 ; Written by Paul Fisher (rao@gnu.org)
9 ; This program is free software; you can redistribute it and/or modify
10 ; it under the terms of the GNU General Public License as published by
11 ; the Free Software Foundation; either version 2 of the License, or
12 ; (at your option) any later version.
14 ; This program is distributed in the hope that it will be useful,
15 ; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 ; GNU General Public License for more details.
19 ; You should have received a copy of the GNU General Public License
20 ; along with this program; if not, write to the Free Software
21 ; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301,
26 (define verbose-log-file "classpath.log")
27 (define summary-log-file "classpath.sum")
29 ; returns the number of times that ELEM appears in the toplevel of LS
37 ((equal? (car ls) elem) (count-it (cdr ls) (+ acc 1)))
38 (else (count-it (cdr ls) acc))))))
41 ; returns a list of pairs containing an element of ELS along with the
42 ; number of times that element appears in LS
43 (define build-result-count
47 (else (cons (cons (car els) (count (car els) ls))
48 (build-result-count (cdr els) ls))))))
50 ; soft port which sends output to both (current-output-port) and
51 ; the verbose-log-port
52 (define screen-and-log-port
58 (newline (current-output-port))
59 (newline verbose-log-port))
61 (write c (current-output-port))
62 (write c verbose-log-port))))
64 (display s (current-output-port))
65 (display s verbose-log-port))
67 (force-output (current-output-port))
68 (force-output verbose-log-port))
73 ; pretty prints the result of a single test
74 (define display-test-summary
76 (let ((name (car result))
79 (display "Name : " port)
82 (display "Result : " port)
85 (display "Message : " port)
86 (if (= (string-length msg) 0)
93 (define display-running
95 (display "Running " port)
100 ; runs the test named CLASS
103 (display-running class screen-and-log-port)
104 (force-output verbose-log-port)
105 (let ((result (test class)))
106 (display-test-summary result screen-and-log-port)
107 (write (cons class result) summary-log-port)
108 (newline summary-log-port)
111 ; run each and every test. each test is read from PORT
112 ; and delimited by a newline. returns a list of all test result codes
113 (define parse-input-file
119 ((eof-object? (car line)) '())
120 ((= (string-length (car line)) 0)
121 (parse-line (read-line port 'split)))
122 (else (cons (run-test (car line))
124 (read-line port 'split))))))))
125 (parse-line (read-line port 'split)))))
127 ; pretty prints the result list
128 (define display-results
129 (lambda (results port)
130 (display "Summary information..." port)
132 (letrec ((display-results-l
137 (let ((res (car ls)))
138 (display "# of " port)
139 (display (car res) port)
141 (display (cdr res) port)
143 (display-results-l (cdr ls)))))))
144 (display-results-l results))))
147 (if (> (length (command-line)) 1)
148 (define input-port (open-input-file (cadr (command-line))))
149 (error "filename listing tests to execute must be specified.")))
151 ; open up the log files
152 (define verbose-log-port (open verbose-log-file
153 (logior O_WRONLY O_CREAT O_TRUNC)))
154 (define summary-log-port (open summary-log-file
155 (logior O_WRONLY O_CREAT O_TRUNC)))
157 ; redirect stderr to the verbose log
158 (dup verbose-log-port 2)
160 ; run the tests, and build the result table, and display the results
161 (display-results (build-result-count
162 '(PASS XPASS FAIL XPAIL UNRESOLVED
163 UNSUPPORTED UNTESTED ERROR)
164 (parse-input-file input-port)) screen-and-log-port)