;;;; $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 :id [: ] ()) 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 is a symbol identifying the environment for the tests :key Additional key-value pairs 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 []) 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* (if (find :asdf2 *features*) (asdf:system-relative-pathname :ansi-compiled "test/lisp/ansi/ansi-test-failures") (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))) (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) (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 report (test version-1 version-2) "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)))))