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

Last change on this file since 14912 was 14912, checked in by Mark Evenson, 6 years ago

Re-write the ABCL ASDF description using secondary systems

Future versions of ASDF will start complaining when multiple DEFSYSTEM
forms occupy a given file unit, but the systems named therein don't
use the "PRIMARYSECONDARY.." naming conventions.

(asdf:test-system :abcl)
Run the ABCL tests located under <file:test/lisp/abcl/>

(asdf:test-system :abcl/test/ansi/compiled)
Run the compiled version of the ANSI tests in <file:../ansi-test/>.

(asdf:test-system :abcl/test/ansi/interpreted)
Run the interpreted version of the ANSI tests in <file:../ansi-test/>.

(asdf:test-system :abcl/test/cl-bench)
Run the CL-BENCH test suite in <file:../cl-bench/>.

  • Property svn:eol-style set to native
  • Property svn:keyword set to Id
File size: 7.0 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  (list 
128   (list (length failures-1)
129         (set-difference failures-1 failures-2))
130   (list (length failures-2)
131         (set-difference failures-2 failures-1))))
132
133(defun generate-report (test version-1 version-2)
134  (flet ((list-results (hash-table)
135           (loop 
136              :for key :being :the :hash-key :of hash-table
137              :using (:hash-value value)
138              :collecting (list key value))))
139    (let ((entries-1 (list-results (get-failures test version-1)))
140          (entries-2 (list-results (get-failures test version-2))))
141      (loop :for (id-1 failure-1) :in entries-1
142         :appending (loop :for (id-2 failure-2) :in entries-2
143                        :collecting (list (cons id-1 id-2)
144                                          (difference failure-1
145                                                      failure-2)))))))
146
147(defun report (test version-1 version-2)
148  "Report on the difference of test failures for TEST between VERSION-1 and VERSION-2.
149
150TEST is symbol with a value of 'DOIT specifying the interpreted
151version of the tests, or 'COMPILEIT specifiying the compiled verision of the tests.
152
153VERSION-1 and VERSION-2 are symbols of two versions contained in the test database."
154
155  (let ((reports (generate-report test version-1 version-2)))
156    (dolist (report reports)
157      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
158                                        (total-failures2 diff-2->1)))
159          report
160        (when diff-1->2
161          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" 
162                version-1 id1 version-2 id2 diff-1->2))
163        (when diff-2->1
164          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%" 
165                  version-2 id2 version-1 id1 diff-2->1))))))
166           
167(defun full-report (version-1 version-2)
168  (let ((interpreted-reports (generate-report 'doit version-1 version-2))
169        (compiled-reports (generate-report 'compileit version-1 version-2)))
170    (dolist (interpreted interpreted-reports)
171      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
172                                        (total-failures2 diff-2->1)))
173          interpreted
174        (format t "~2&Interpreted~%")
175        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
176        (format t "~&~20<~A failures~>~20<~A failures~>" 
177                total-failures1 total-failures2)
178        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
179        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))
180    (dolist (compiled compiled-reports)
181      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
182                                        (total-failures2 diff-2->1)))
183          compiled
184        (format t "~2&Compiled~%")
185        (format t "~&~20<~A-~A~>~20<~A-~A~>" id1  version-1 id2 version-2)
186        (format t "~&~20<~A failures~>~20<~A failures~>" 
187                total-failures1 total-failures2)
188        (format t "~&~A-~A:~&  ~A" id1 version-1 diff-1->2)
189        (format t "~&~A-~A:~&  ~A" id2 version-2 diff-2->1)))))
190
191     
192   
193 
194   
195       
Note: See TracBrowser for help on using the repository browser.