[armedbear-cvs] r12509 - in trunk/abcl: . test/lisp/ansi
Mark Evenson
mevenson at common-lisp.net
Sat Feb 27 07:01:02 UTC 2010
Author: mevenson
Date: Sat Feb 27 02:01:01 2010
New Revision: 12509
Log:
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.
Added:
trunk/abcl/test/lisp/ansi/ansi-test-failures (contents, props changed)
Modified:
trunk/abcl/abcl.asd
trunk/abcl/test/lisp/ansi/package.lisp
trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp (contents, props changed)
Modified: trunk/abcl/abcl.asd
==============================================================================
--- trunk/abcl/abcl.asd (original)
+++ trunk/abcl/abcl.asd Sat Feb 27 02:01:01 2010
@@ -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))))
Added: trunk/abcl/test/lisp/ansi/ansi-test-failures
==============================================================================
--- (empty file)
+++ trunk/abcl/test/lisp/ansi/ansi-test-failures Sat Feb 27 02:01:01 2010
@@ -0,0 +1,178 @@
+;;;; -*- 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
Modified: trunk/abcl/test/lisp/ansi/package.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/package.lisp (original)
+++ trunk/abcl/test/lisp/ansi/package.lisp Sat Feb 27 02:01:01 2010
@@ -1,7 +1,7 @@
(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)
Modified: trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp (original)
+++ trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp Sat Feb 27 02:01:01 2010
@@ -1,5 +1,7 @@
;;;; $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 @@
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))))))
More information about the armedbear-cvs
mailing list