source: trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp

Last change on this file was 15416, checked in by Mark Evenson, 4 years ago

ansi-tests: default reporting is for compiled tests
  • Property svn:eol-style set to native
  • Property svn:keyword set to Id
File size: 8.4 KB
Line 
1;;;; $Id$
2;;;;
3;;;; Parse ANSI test results from a s-expr database, allowing queries
4;;;; to show differences.
5;;;;
6;;;; 'cuz I get lost after comparing about five items in a list
7;;;;
8
9#|
10
11To use
12
131.  Create a "database" of test results consisting of s-exps.  A
14    default database is in 'failures'.
15   
16    The s-exprs have the form:
17   
18   (compileit|doit <version> :id <id> [:<key> <value>]
19     (<failing test results>))
20
21where
22
23   compileit|doit   The symbol 'compileit' or 'doit' depending on
24                    whether the compiled or interpreted tests were run.
25
26   version          A symbol identifying the version of source of the
27                    tests (i.e. r12506 or 0.18.0)
28
29   :id <id>         <id> is a symbol identifying the environment for
30                    the tests
31
32   :key <value>     Additional key-value pairs
33
34   <failing test results>
35                    The list of symbols failing the tests.
36
37An example on an entry:
38
39  (doit r12506 :id jupiter
40      :uname "i386-pc-solaris2.11"  :jvm "jdk-1.6.0_13"
41   (REINITIALIZE-INSTANCE.ERROR.1 DEFGENERIC.ERROR.20
42    DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1
43    CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15
44    INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4
45    DELETE-PACKAGE.5 DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4
46    CHAR-UPCASE.2 CHAR-DOWNCASE.2 FRESH-LINE.5 PRINT.RANDOM-STATE.1
47    PPRINT-FILL.14 PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13
48    PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8
49    FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2
50    FORMAT.LOGICAL-BLOCK.CIRCLE.3 FORMAT.JUSTIFY.30 FORMAT.JUSTIFY.32
51    WITH-STANDARD-IO-SYNTAX.23))
52
532.  Run (PARSE [<filename>]) on the file of your database.  Without an
54    argument, the default database is read.
55
563.  Then differences between versions can be queried via REPORT
57
58   CL-USER> (REPORT 'compileit '0.18.0 'r13590)
59
60|#
61
62(in-package :abcl.test.ansi)
63
64(defvar *doit* (make-hash-table))
65(defvar *compileit* (make-hash-table))
66(defvar *id* (make-hash-table))
67
68(defun reset ()
69  (clrhash *doit*)
70  (clrhash *compileit*)
71  (clrhash *id*))
72
73(defun get-hash-table (test)
74  (let ((name (symbol-name test)))
75    (when (string-equal name "doit")
76      (return-from get-hash-table *doit*))
77    (when (string-equal name "compileit")
78      (return-from get-hash-table *compileit*))))
79
80(defvar *default-database-file* 
81  (asdf:system-relative-pathname
82   :abcl "test/lisp/ansi/ansi-test-failures"))
83
84(defun parse (&optional (file *default-database-file*))
85  "Parse the ansi test database present at *DEFAULT-DATABASE-FILE*.
86
87Optionally the file to parse may be specified by the FILE argument."
88  (format t "Parsing test report database from ~A~%" *default-database-file*)
89  (with-open-file (s file :direction :input)
90    (do ((form (read s) (read s nil nil)))
91         ((null form))
92      (destructuring-bind (test version &rest rest) form
93        (let ((args) (failures) (id))
94          (dolist (arg rest)
95            (if (typep arg 'cons)
96                (setf failures arg)
97                (push arg args)))
98          (setf args (nreverse args))
99          (unless (getf args :id)
100            (push 'noid args) 
101            (push :id args))
102          (setf id (getf args :id))
103          (unless (gethash version (get-hash-table test))
104            (setf (gethash version (get-hash-table test))
105                  (make-hash-table)))
106          (if (> (length args) 2)
107              (setf (gethash id *id*) args)
108              (if (null (gethash id *id*))
109                  (setf (gethash id *id*) args)))
110          (setf (gethash id
111                         (gethash version (get-hash-table test)))
112                failures))))))
113
114(defun versions (test)
115  (loop :for key :being :the :hash-keys :of (get-hash-table test)
116     :collecting key))
117
118(defun report-versions (&optional (test 'compileit))
119  (format t "~A has the following versions:~%~A~%" 
120          test (versions test))
121  (values))
122
123(defun get-failures (test version)
124  (gethash version (get-hash-table test)))
125
126(defun difference (failures-1 failures-2)
127  "Report the set-difference between the lists of FAILURES-1 and FAILURES-2"
128  (list 
129   (list (length failures-1)
130         (set-difference failures-1 failures-2))
131   (list (length failures-2)
132         (set-difference failures-2 failures-1))))
133
134(defun generate-report (test version-1 version-2)
135  (flet ((list-results (hash-table)
136           (loop 
137              :for key :being :the :hash-key :of hash-table
138              :using (:hash-value value)
139              :collecting (list key value))))
140    (let ((entries-1 (list-results (get-failures test version-1)))
141          (entries-2 (list-results (get-failures test version-2))))
142      (loop :for (id-1 failure-1) :in entries-1
143         :appending (loop :for (id-2 failure-2) :in entries-2
144                        :collecting (list (cons id-1 id-2)
145                                          (difference failure-1
146                                                      failure-2)))))))
147
148(defun deprecated/report (test version-1 version-2)
149  (report version-1 version-2 :test test))
150 
151(defun report (version-1 version-2 &key (test 'compileit))
152  "Report on the difference of test failures for TEST between VERSION-1 and VERSION-2.
153
154TEST is symbol with a value of 'DOIT specifying the interpreted
155version of the tests, or 'COMPILEIT specifiying the compiled verision of the tests.
156
157VERSION-1 and VERSION-2 are symbols of two versions contained in the test database."
158
159  (let ((reports (generate-report test version-1 version-2)))
160    (dolist (report reports)
161      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
162                                        (total-failures2 diff-2->1)))
163          report
164        (when diff-1->2
165          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" 
166                version-1 id1 version-2 id2 diff-1->2))
167        (when diff-2->1
168          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" 
169                  version-2 id2 version-1 id1 diff-2->1))))))
170           
171(defun full-report (version-1 version-2)
172  (let ((interpreted-reports (generate-report 'doit version-1 version-2))
173        (compiled-reports (generate-report 'compileit version-1 version-2)))
174    (dolist (interpreted interpreted-reports)
175      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
176                                        (total-failures2 diff-2->1)))
177          interpreted
178        (format t "~2&Interpreted~%")
179        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
180        (format t "~&~20<~A failures~>~20<~A failures~>" 
181                total-failures1 total-failures2)
182        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
183        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))
184    (dolist (compiled compiled-reports)
185      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
186                                        (total-failures2 diff-2->1)))
187          compiled
188        (format t "~2&Compiled~%")
189        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
190        (format t "~&~20<~A failures~>~20<~A failures~>" 
191                total-failures1 total-failures2)
192        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
193        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))))
194
195(defun report-compiled (version-1 version-2)
196  (let ((compiled-reports (generate-report 'compileit version-1 version-2)))
197    (dolist (interpreted interpreted-reports)
198      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
199                                        (total-failures2 diff-2->1)))
200          interpreted
201        (format t "~2&Interpreted~%")
202        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
203        (format t "~&~20<~A failures~>~20<~A failures~>" 
204                total-failures1 total-failures2)
205        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
206        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))
207    (dolist (compiled compiled-reports)
208      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
209                                        (total-failures2 diff-2->1)))
210          compiled
211        (format t "~2&Compiled~%")
212        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
213        (format t "~&~20<~A failures~>~20<~A failures~>" 
214                total-failures1 total-failures2)
215        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
216        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))))
217
218     
219   
220 
221   
222       
Note: See TracBrowser for help on using the repository browser.