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

Last change on this file since 15286 was 15286, checked in by Mark Evenson, 2 years ago

Update ansi-tests

Add recent results to ansi test database.

Add the ASDF system name as a nickname.

Export and add a docstring for DIFFERENCE.

  • Property svn:eol-style set to native
  • Property svn:keyword set to Id
File size: 7.1 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 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.