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
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
|
;;;; $Id$
;;;;
;;;; Parse ANSI test results from a s-expr database, allowing queries
;;;; to show differences.
;;;;
;;;; 'cuz I get lost after comparing about five items in a list
;;;;
#|
To use
1. Create a "database" of test results consisting of s-exps. A
default database is in 'failures'.
The s-exprs have the form:
(compileit|doit <version> :id <id> [:<key> <value>]
(<failing test results>))
where
compileit|doit The symbol 'compileit' or 'doit' depending on
whether the compiled or interpreted tests were run.
version A symbol identifying the version of source of the
tests (i.e. r12506 or 0.18.0)
:id <id> <id> is a symbol identifying the environment for
the tests
:key <value> Additional key-value pairs
<failing test results>
The list of symbols failing the tests.
An example on an entry:
(doit r12506 :id jupiter
:uname "i386-pc-solaris2.11" :jvm "jdk-1.6.0_13"
(REINITIALIZE-INSTANCE.ERROR.1 DEFGENERIC.ERROR.20
DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1
CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15
INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4
DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4
CHAR-UPCASE.2 CHAR-DOWNCASE.2 FRESH-LINE.5 PRINT.RANDOM-STATE.1
PPRINT-FILL.14 PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13
PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8
FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2
FORMAT.LOGICAL-BLOCK.CIRCLE.3 FORMAT.JUSTIFY.30 FORMAT.JUSTIFY.32
WITH-STANDARD-IO-SYNTAX.23))
2. Run (PARSE [<filename>]) on the file of your database. Without an
argument, the default database is read.
3. Then differences between versions can be queried via REPORT
CL-USER> (REPORT 'compileit '0.18.0 'r13590)
|#
(in-package :abcl.test.ansi)
(defvar *doit* (make-hash-table))
(defvar *compileit* (make-hash-table))
(defvar *id* (make-hash-table))
(defun reset ()
(clrhash *doit*)
(clrhash *compileit*)
(clrhash *id*))
(defun get-hash-table (test)
(let ((name (symbol-name test)))
(when (string-equal name "doit")
(return-from get-hash-table *doit*))
(when (string-equal name "compileit")
(return-from get-hash-table *compileit*))))
(defvar *default-database-file*
(asdf:system-relative-pathname
:abcl "test/lisp/ansi/ansi-test-failures"))
(defun parse (&optional (file *default-database-file*))
"Parse the ansi test database present at *DEFAULT-DATABASE-FILE*.
Optionally the file to parse may be specified by the FILE argument."
(format t "Parsing test report database from ~A~%" *default-database-file*)
(with-open-file (s file :direction :input)
(do ((form (read s) (read s nil nil)))
((null form))
(destructuring-bind (test version &rest rest) form
(let ((args) (failures) (id))
(dolist (arg rest)
(if (typep arg 'cons)
(setf failures arg)
(push arg args)))
(setf args (nreverse args))
(unless (getf args :id)
(push 'noid args)
(push :id args))
(setf id (getf args :id))
(unless (gethash version (get-hash-table test))
(setf (gethash version (get-hash-table test))
(make-hash-table)))
(if (> (length args) 2)
(setf (gethash id *id*) args)
(if (null (gethash id *id*))
(setf (gethash id *id*) args)))
(setf (gethash id
(gethash version (get-hash-table test)))
failures))))))
(defun versions (test)
(loop :for key :being :the :hash-keys :of (get-hash-table test)
:collecting key))
(defun report-versions (&optional (test 'compileit))
(format t "~A has the following versions:~%~A~%"
test (versions test))
(values))
(defun get-failures (test version)
(gethash version (get-hash-table test)))
(defun difference (failures-1 failures-2)
"Report the set-difference between the lists of FAILURES-1 and FAILURES-2"
(list
(list (length failures-1)
(set-difference failures-1 failures-2))
(list (length failures-2)
(set-difference failures-2 failures-1))))
(defun generate-report (test version-1 version-2)
(flet ((list-results (hash-table)
(loop
:for key :being :the :hash-key :of hash-table
:using (:hash-value value)
:collecting (list key value))))
(let ((entries-1 (list-results (get-failures test version-1)))
(entries-2 (list-results (get-failures test version-2))))
(loop :for (id-1 failure-1) :in entries-1
:appending (loop :for (id-2 failure-2) :in entries-2
:collecting (list (cons id-1 id-2)
(difference failure-1
failure-2)))))))
(defun deprecated/report (test version-1 version-2)
(report version-1 version-2 :test test))
(defun report (version-1 version-2 &key (test 'compileit))
"Report on the difference of test failures for TEST between VERSION-1 and VERSION-2.
TEST is symbol with a value of 'DOIT specifying the interpreted
version of the tests, or 'COMPILEIT specifiying the compiled verision of the tests.
VERSION-1 and VERSION-2 are symbols of two versions contained in the test database."
(let ((reports (generate-report test version-1 version-2)))
(dolist (report reports)
(destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
(total-failures2 diff-2->1)))
report
(when diff-1->2
(format t "~A[~A] --> ~A[~A] additional failures:~%~A~%"
version-1 id1 version-2 id2 diff-1->2))
(when diff-2->1
(format t "~A[~A] --> ~A[~A] additional failures:~%~A~%"
version-2 id2 version-1 id1 diff-2->1))))))
(defun full-report (version-1 version-2)
(let ((interpreted-reports (generate-report 'doit version-1 version-2))
(compiled-reports (generate-report 'compileit version-1 version-2)))
(dolist (interpreted interpreted-reports)
(destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
(total-failures2 diff-2->1)))
interpreted
(format t "~2&Interpreted~%")
(format t "~&~20<~A-~A~>~20<~A-~A~>" id1 version-1 id2 version-2)
(format t "~&~20<~A failures~>~20<~A failures~>"
total-failures1 total-failures2)
(format t "~&~A-~A:~& ~A" id1 version-1 diff-1->2)
(format t "~&~A-~A:~& ~A" id2 version-2 diff-2->1)))
(dolist (compiled compiled-reports)
(destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
(total-failures2 diff-2->1)))
compiled
(format t "~2&Compiled~%")
(format t "~&~20<~A-~A~>~20<~A-~A~>" id1 version-1 id2 version-2)
(format t "~&~20<~A failures~>~20<~A failures~>"
total-failures1 total-failures2)
(format t "~&~A-~A:~& ~A" id1 version-1 diff-1->2)
(format t "~&~A-~A:~& ~A" id2 version-2 diff-2->1)))))
(defun report-compiled (version-1 version-2)
(let ((compiled-reports (generate-report 'compileit version-1 version-2)))
(dolist (interpreted interpreted-reports)
(destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
(total-failures2 diff-2->1)))
interpreted
(format t "~2&Interpreted~%")
(format t "~&~20<~A-~A~>~20<~A-~A~>" id1 version-1 id2 version-2)
(format t "~&~20<~A failures~>~20<~A failures~>"
total-failures1 total-failures2)
(format t "~&~A-~A:~& ~A" id1 version-1 diff-1->2)
(format t "~&~A-~A:~& ~A" id2 version-2 diff-2->1)))
(dolist (compiled compiled-reports)
(destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
(total-failures2 diff-2->1)))
compiled
(format t "~2&Compiled~%")
(format t "~&~20<~A-~A~>~20<~A-~A~>" id1 version-1 id2 version-2)
(format t "~&~20<~A failures~>~20<~A failures~>"
total-failures1 total-failures2)
(format t "~&~A-~A:~& ~A" id1 version-1 diff-1->2)
(format t "~&~A-~A:~& ~A" id2 version-2 diff-2->1)))))
|
