1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
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)
|
