ANSI test database can now contain multiple test results per version.

We change the syntax of the ANSI test results database to allow the
specification of a unique identifier plus other optional identifying
information by allowing keyword/value pairs.  The keyword :ID
specifies the identifier, which should be a symbol.  Other arbitrary
keywords are allowed which specify additional information to be
associated with the symbol specified by :ID in the *ID* hashtable.
Not every test failure entry needs to specify this information.  In
case of duplicates, the last entry wins.  Suggested other keywords are
:JVM to specify the Java virtual machine, and :UNAME to specify the
operating system/hardware combination in a GNU autoconf-like string.
See the comments at the beginning of 'parse-ansi-errors.lisp' for more
details.

The utility has been packaged in ABCL.ANSI.TEST, showing up in the
ANSI-COMPILED and ANSI-INTERPRETED ASDF systems loadable from
'abcl.asd'.

A database of failures has been included in 'ansi-test-failures'.  It
is intended that other developers entrich this database with their own
test results.
parent a3e95b8a
......@@ -46,10 +46,11 @@
(funcall (intern (symbol-name 'run) :abcl.test.lisp)))
;;; Test ABCL with the interpreted ANSI tests
(defsystem :ansi-interpreted :version "1.0.1"
(defsystem :ansi-interpreted :version "1.1"
:components
((:module ansi-tests :pathname "test/lisp/ansi/" :components
((:file "package")))))
((:file "package")
(:file "parse-ansi-errors" :depends-on ("package"))))))
(defmethod perform :before ((o test-op) (c (eql (find-system :ansi-interpreted))))
(operate 'load-op :ansi-interpreted))
(defmethod perform ((o test-op) (c (eql (find-system :ansi-interpreted))))
......@@ -57,10 +58,11 @@
:compile-tests nil))
;;; Test ABCL with the compiled ANSI tests
(defsystem :ansi-compiled :version "1.0.1"
(defsystem :ansi-compiled :version "1.1"
:components
((:module ansi-tests :pathname "test/lisp/ansi/" :components
((:file "package")))))
((:file "package")
(:file "parse-ansi-errors" :depends-on ("package"))))))
(defmethod perform :before ((o test-op) (c (eql (find-system :ansi-compiled))))
(operate 'load-op :ansi-compiled))
(defmethod perform ((o test-op) (c (eql (find-system :ansi-compiled))))
......
;;;; -*- Mode: LISP; Syntax: COMMON-LISP -*-
(doit r12506 :id dada
:uname "x64-darwin-10.2.0" :jvm "apple-jdk-1.6.0_17"
(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
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
ENSURE-DIRECTORIES-EXIST.8 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))
(compileit r12506 :id dada
(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
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
ENSURE-DIRECTORIES-EXIST.8 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 TRACE.8))
; prevent duplicate subclasses
; introduces PRINT.BACKQUOTE.RANDOM.14
;r12391 781
(doit r12391 :id dada
(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 ENSURE-DIRECTORIES-EXIST.8
FRESH-LINE.5 MAKE-BROADCAST-STREAM.8 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))
(compileit r12391 :id dada
(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
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
ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5 MAKE-BROADCAST-STREAM.8
PRINT.BACKQUOTE.RANDOM.14 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 TRACE.8))
; change output-ugly-object
;r12390 780
;doit nil
(compileit r12390 :id dada
(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
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
ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5 MAKE-BROADCAST-STREAM.8
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 TRACE.8))
; changelogs for newest release
;r12383 779
;doit nil
(compileit r12383 :id dada
(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
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
ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5 MAKE-BROADCAST-STREAM.8
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 TRACE.8))
;abcl-src-0.18.0
(doit 0.18.0 :id dada
(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
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 ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5
MAKE-BROADCAST-STREAM.8 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))
(compileit 0.18.0 :id dada
(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
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 ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5
MAKE-BROADCAST-STREAM.8 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 TRACE.8))
(doit 0.18.1 :id dada
(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
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 ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5
MAKE-BROADCAST-STREAM.8 PRINT.BACKQUOTE.RANDOM.14
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))
(compileit 0.18.1 :id dada
(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
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 ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5
MAKE-BROADCAST-STREAM.8 PRINT.BACKQUOTE.RANDOM.14
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
TRACE.8))
(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))
(compileit r12506 :id jupiter
(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 ENSURE-DIRECTORIES-EXIST.8
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
TRACE.8))
\ No newline at end of file
(defpackage :abcl.test.ansi
(:use :cl :asdf)
(:nicknames "ansi-tests" "abcl-ansi-tests" "gcl-ansi")
(:export :run))
(:export :run :report :parse))
(in-package :abcl.test.ansi)
......
;;;; $Id$
;;;; Parse ANSI test list
;;;;
;;;; 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
;;;;
......@@ -8,9 +10,13 @@
To use
1. create a "database" of test results consisting of S-exp of form
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 <version> (<failing test results>))
(compileit|doit <version> :id <id> [:<key> <value>]
(<failing test results>))
where
......@@ -18,61 +24,130 @@ where
whether the compiled or interpreted tests were run.
version A symbol identifying the version of source of the
tests.
tests (i.e. r12506 or 0.18.0)
:id <id> <id> is a symbol identifying the environment for
the tests
:key <value> Additional key-value pairs
<failing test results>
The list of symbols failing the tests.
An example:
An example on an entry:
(compileit 0.18.1 (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
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
ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5 MAKE-BROADCAST-STREAM.8
PRINT.BACKQUOTE.RANDOM.14 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 TRACE.8)).
(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 <filename>) on the file of your database.
2. Run (PARSE [<filename>]) on the file of your database. Without an
argument, the default database is read.
3. Then differences between versions can be queried via DIFFERENCE
3. Then differences between versions can be queried via REPORT
CL-USER> (difference 'compileit '0.18.0 'r13590)
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)
(getf `(doit ,*doit* compileit ,*compileit*) test))
(defun parse (&optional (file #p"failures")
(defvar *default-database-file*
(merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
(defun parse (&optional (file *default-database-file*))
(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 failures) form
(setf (gethash version
(get-hash-table test))
failures)))))
(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))
(if (> (length args) 2)
(setf (gethash id *id*) args)
(if (null (gethash id *id*))
(setf (gethash id *id*) args)))
(when (null (gethash version (get-hash-table test)))
(setf (gethash version (get-hash-table test))
(make-hash-table)))
(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 difference (test version-1 version-2)
(let ((failures-1 (gethash version-1 (get-hash-table test)))
(failures-2 (gethash version-2 (get-hash-table test))))
(format t "~A: ~A failures~% ~A~%"
version-1 (length failures-1) (set-difference failures-1 failures-2))
(format t "~A: ~A failures~% ~A~%"
version-2 (length failures-2) (set-difference failures-2 failures-1)))
(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)
(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))))))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment