source: branches/streams/abcl/test/lisp/ansi/parse-ansi-errors.lisp

Last change on this file was 13401, checked in by Mark Evenson, 13 years ago

ANSI-TESTS:FULL-REPORT provides a clearer reports of test failures.

Added test results between 0.25.0 and 0.26.0 on Solaris.

  • Property svn:eol-style set to native
  • Property svn:keyword set to Id
File size: 7.2 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  (if (find :asdf2 *features*)
82      (asdf:system-relative-pathname :ansi-compiled "test/lisp/ansi/ansi-test-failures")
83      (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*))))
84
85(defun parse (&optional (file *default-database-file*))
86  "Parse the ansi test database present at *DEFAULT-DATABASE-FILE*.
87
88Optionally the file to parse may be specified by the FILE argument."
89  (format t "Parsing test report database from ~A~%" *default-database-file*)
90  (with-open-file (s file :direction :input)
91    (do ((form (read s) (read s nil nil)))
92         ((null form))
93      (destructuring-bind (test version &rest rest) form
94        (let ((args) (failures) (id))
95          (dolist (arg rest)
96            (if (typep arg 'cons)
97                (setf failures arg)
98                (push arg args)))
99          (setf args (nreverse args))
100          (unless (getf args :id)
101            (push 'noid args) 
102            (push :id args))
103          (setf id (getf args :id))
104          (unless (gethash version (get-hash-table test))
105            (setf (gethash version (get-hash-table test))
106                  (make-hash-table)))
107          (if (> (length args) 2)
108              (setf (gethash id *id*) args)
109              (if (null (gethash id *id*))
110                  (setf (gethash id *id*) args)))
111          (setf (gethash id
112                         (gethash version (get-hash-table test)))
113                failures))))))
114
115(defun versions (test)
116  (loop :for key :being :the :hash-keys :of (get-hash-table test)
117     :collecting key))
118
119(defun report-versions (&optional (test 'compileit))
120  (format t "~A has the following versions:~%~A~%" 
121          test (versions test))
122  (values))
123
124(defun get-failures (test version)
125  (gethash version (get-hash-table test)))
126
127(defun difference (failures-1 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 report (test version-1 version-2)
149  "Report on the difference of test failures for TEST between VERSION-1 and VERSION-2.
150
151TEST is symbol with a value of 'DOIT specifying the interpreted
152version of the tests, or 'COMPILEIT specifiying the compiled verision of the tests.
153
154VERSION-1 and VERSION-2 are symbols of two versions contained in the test database."
155
156  (let ((reports (generate-report test version-1 version-2)))
157    (dolist (report reports)
158      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
159                                        (total-failures2 diff-2->1)))
160          report
161        (when diff-1->2
162          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" 
163                version-1 id1 version-2 id2 diff-1->2))
164        (when diff-2->1
165          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" 
166                  version-2 id2 version-1 id1 diff-2->1))))))
167           
168(defun full-report (version-1 version-2)
169  (let ((interpreted-reports (generate-report 'doit version-1 version-2))
170        (compiled-reports (generate-report 'compileit version-1 version-2)))
171    (dolist (interpreted interpreted-reports)
172      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
173                                        (total-failures2 diff-2->1)))
174          interpreted
175        (format t "~2&Interpreted~%")
176        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
177        (format t "~&~20<~A failures~>~20<~A failures~>" 
178                total-failures1 total-failures2)
179        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
180        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))
181    (dolist (compiled compiled-reports)
182      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
183                                        (total-failures2 diff-2->1)))
184          compiled
185        (format t "~2&Compiled~%")
186        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
187        (format t "~&~20<~A failures~>~20<~A failures~>" 
188                total-failures1 total-failures2)
189        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
190        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))))
191
192     
193   
194 
195   
196       
Note: See TracBrowser for help on using the repository browser.