Changeset 12509


Ignore:
Timestamp:
02/27/10 07:01:01 (12 years ago)
Author:
Mark Evenson
Message:

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.

Location:
trunk/abcl
Files:
1 added
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/abcl/abcl.asd

    r12406 r12509  
    4747
    4848;;; Test ABCL with the interpreted ANSI tests
    49 (defsystem :ansi-interpreted :version "1.0.1"
     49(defsystem :ansi-interpreted :version "1.1"
    5050           :components
    5151           ((:module ansi-tests :pathname "test/lisp/ansi/" :components
    52          ((:file "package")))))
     52         ((:file "package")
     53                (:file "parse-ansi-errors" :depends-on ("package"))))))
    5354(defmethod perform :before ((o test-op) (c (eql (find-system :ansi-interpreted))))
    5455  (operate 'load-op :ansi-interpreted))
     
    5859
    5960;;; Test ABCL with the compiled ANSI tests
    60 (defsystem :ansi-compiled :version "1.0.1"
     61(defsystem :ansi-compiled :version "1.1"
    6162           :components
    6263           ((:module ansi-tests :pathname "test/lisp/ansi/" :components
    63          ((:file "package")))))
     64         ((:file "package")
     65                (:file "parse-ansi-errors" :depends-on ("package"))))))
    6466(defmethod perform :before ((o test-op) (c (eql (find-system :ansi-compiled))))
    6567  (operate 'load-op :ansi-compiled))
  • trunk/abcl/test/lisp/ansi/package.lisp

    r11599 r12509  
    22  (:use :cl :asdf)
    33  (:nicknames "ansi-tests" "abcl-ansi-tests" "gcl-ansi")
    4   (:export :run))
     4  (:export :run :report :parse))
    55
    66(in-package :abcl.test.ansi)
  • trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp

    • Property svn:eol-style set to native
    • Property svn:keyword set to Id
    r12508 r12509  
    11;;;; $Id$
    2 ;;;; Parse ANSI test list
     2;;;;
     3;;;; Parse ANSI test results from a s-expr database, allowing queries
     4;;;; to show differences.
    35;;;;
    46;;;; 'cuz I get lost after comparing about five items in a list
     
    911To use
    1012
    11 1.  create a "database" of test results consisting of S-exp of form
     131.  Create a "database" of test results consisting of s-exps.  A
     14    default database is in 'failures'.
    1215   
    13    (compileit|doit <version> (<failing test results>))
     16    The s-exprs have the form:
     17   
     18   (compileit|doit <version> :id <id> [:<key> <value>]
     19     (<failing test results>))
    1420
    1521where
     
    1925
    2026   version          A symbol identifying the version of source of the
    21                     tests.
     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
    2233
    2334   <failing test results>
    2435                    The list of symbols failing the tests.
    2536
    26 An example:
     37An example on an entry:
    2738
    28 (compileit 0.18.1 (REINITIALIZE-INSTANCE.ERROR.1 DEFGENERIC.ERROR.20
    29 DEFGENERIC.ERROR.21 DEFGENERIC.30 CALL-NEXT-METHOD.ERROR.1
    30 CALL-NEXT-METHOD.ERROR.2 DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15
    31 MAKE-CONDITION.3 MAKE-CONDITION.4 DELETE-PACKAGE.5 DELETE-PACKAGE.6
    32 MAP.48 TYPE-OF.1 TYPE-OF.4 CHAR-UPCASE.2 CHAR-DOWNCASE.2
    33 ENSURE-DIRECTORIES-EXIST.8 FRESH-LINE.5 MAKE-BROADCAST-STREAM.8
    34 PRINT.BACKQUOTE.RANDOM.14 PRINT.RANDOM-STATE.1 PPRINT-FILL.14
    35 PPRINT-FILL.15 PPRINT-LINEAR.14 PPRINT-TABULAR.13
    36 PPRINT-LOGICAL-BLOCK.17 PPRINT-POP.7 PPRINT-POP.8
    37 FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2
    38 FORMAT.LOGICAL-BLOCK.CIRCLE.3 FORMAT.JUSTIFY.30 FORMAT.JUSTIFY.32
    39 WITH-STANDARD-IO-SYNTAX.23 TRACE.8)).
     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))
    4052
    41 2.  Run (PARSE <filename>) on the file of your database.
     532.  Run (PARSE [<filename>]) on the file of your database.  Without an
     54    argument, the default database is read.
    4255
    43 3.  Then differences between versions can be queried via DIFFERENCE
     563.  Then differences between versions can be queried via REPORT
    4457
    45    CL-USER> (difference 'compileit '0.18.0 'r13590)
     58   CL-USER> (REPORT 'compileit '0.18.0 'r13590)
    4659
    4760|#
    4861
     62(in-package :abcl.test.ansi)
     63
    4964(defvar *doit* (make-hash-table))
    5065(defvar *compileit* (make-hash-table))
     66(defvar *id* (make-hash-table))
     67
     68(defun reset ()
     69  (clrhash *doit*)
     70  (clrhash *compileit*)
     71  (clrhash *id*))
    5172
    5273(defun get-hash-table (test)
    5374  (getf `(doit ,*doit* compileit ,*compileit*) test)) 
    5475
    55 (defun parse (&optional (file #p"failures")
     76(defvar *default-database-file*
     77  (merge-pathnames "ansi-test-failures" (directory-namestring *load-truename*)))
     78
     79(defun parse (&optional (file *default-database-file*))
     80  (format t "Parsing test report database from ~A~%" *default-database-file*)
    5681  (with-open-file (s file :direction :input)
    5782    (do ((form (read s) (read s nil nil)))
    5883         ((null form))
    59       (destructuring-bind (test version failures) form
    60         (setf (gethash version
    61                        (get-hash-table test))
    62               failures)))))
     84      (destructuring-bind (test version &rest rest) form
     85        (let ((args) (failures) (id))
     86          (dolist (arg rest)
     87            (if (typep arg 'cons)
     88                (setf failures arg)
     89                (push arg args)))
     90          (setf args (nreverse args))
     91          (unless (getf args :id)
     92            (push 'noid args)
     93            (push :id args))
     94          (setf id (getf args :id))
     95          (if (> (length args) 2)
     96              (setf (gethash id *id*) args)
     97              (if (null (gethash id *id*))
     98                  (setf (gethash id *id*) args)))
     99          (when (null (gethash version (get-hash-table test)))
     100            (setf (gethash version (get-hash-table test))
     101                  (make-hash-table)))
     102          (setf (gethash id
     103                         (gethash version (get-hash-table test)))
     104                failures))))))
    63105
    64106(defun versions (test)
     
    66108     :collecting key))
    67109
    68 (defun difference (test version-1 version-2)
    69   (let ((failures-1 (gethash version-1 (get-hash-table test)))
    70         (failures-2 (gethash version-2 (get-hash-table test))))
    71     (format t "~A: ~A failures~% ~A~%"
    72             version-1 (length failures-1) (set-difference failures-1 failures-2))
    73     (format t "~A: ~A failures~% ~A~%"
    74             version-2 (length failures-2) (set-difference failures-2 failures-1)))
     110(defun report-versions (&optional (test 'compileit))
     111  (format t "~A has the following versions:~%~A~%"
     112          test (versions test))
    75113  (values))
     114
     115(defun get-failures (test version)
     116  (gethash version (get-hash-table test)))
     117
     118(defun difference (failures-1 failures-2)
     119  (list
     120   (list (length failures-1)
     121         (set-difference failures-1 failures-2))
     122   (list (length failures-2)
     123         (set-difference failures-2 failures-1))))
     124
     125(defun generate-report (test version-1 version-2)
     126  (flet ((list-results (hash-table)
     127           (loop
     128              :for key :being :the :hash-key :of hash-table
     129              :using (:hash-value value)
     130              :collecting (list key value))))
     131    (let ((entries-1 (list-results (get-failures test version-1)))
     132          (entries-2 (list-results (get-failures test version-2))))
     133      (loop :for (id-1 failure-1) :in entries-1
     134         :appending (loop :for (id-2 failure-2) :in entries-2
     135                        :collecting (list (cons id-1 id-2)
     136                                          (difference failure-1
     137                                                      failure-2)))))))
     138
     139(defun report (test version-1 version-2)
     140  (let ((reports (generate-report test version-1 version-2)))
     141    (dolist (report reports)
     142      (destructuring-bind ((id1 . id2) ((total-failures1 diff-1->2)
     143                                        (total-failures2 diff-2->1)))
     144          report
     145        (when diff-1->2
     146          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%"
     147                version-1 id1 version-2 id2 diff-1->2))
     148        (when diff-2->1
     149          (format t "~A[~A] --> ~A[~A] additional failures:~%~A~%"
     150                  version-2 id2 version-1 id1 diff-2->1))))))
    76151           
    77152 
Note: See TracChangeset for help on using the changeset viewer.