Commit 7ff336b0 authored by mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f's avatar mevenson@1c010e3e-69d0-11dd-93a8-456734b0d56f
Browse files

ANSI-TESTS:FULL-REPORT provides a clearer reports of test failures.

Added test results between 0.25.0 and 0.26.0 on Solaris.
parent fd7b6c14
......@@ -358,3 +358,62 @@
FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2
FORMAT.LOGICAL-BLOCK.CIRCLE.3 WITH-STANDARD-IO-SYNTAX.23 TRACE.8))
(doit 0.25.0 :id saturn
:uname "i386-pc-solaris2.11.oi_148" :jvm "jdk-1.6.0_25"
(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 MAKE-PATHNAME.9
ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2
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
COMPILE-FILE.16))
(compileit 0.25.0 :id saturn
:uname "i386-pc-solaris2.11.oi_148" :jvm "jdk-1.6.0_25"
(MULTIPLE-VALUE-PROG1.10 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 MAKE-PATHNAME.9
ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2
PRINT.SYMBOL.RANDOM.4 PRINT.STRING.RANDOM.1 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 COMPILE-FILE.16 TRACE.8))
(doit 0.26.0 :id saturn
(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-NAME.1
ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.2
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.C.2A FORMATTER.C.2A
FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2
FORMAT.LOGICAL-BLOCK.CIRCLE.3 SYNTAX.SHARP-BACKSLASH.6
SYNTAX.SHARP-BACKSLASH.7))
(compileit 0.26.0 :id saturn
(MULTIPLE-VALUE-PROG1.10 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-NAME.1
ENSURE-DIRECTORIES-EXIST.8 PRINT.SYMBOL.RANDOM.4
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.C.2A FORMATTER.C.2A
FORMAT.LOGICAL-BLOCK.CIRCLE.1 FORMAT.LOGICAL-BLOCK.CIRCLE.2
FORMAT.LOGICAL-BLOCK.CIRCLE.3 SYNTAX.SHARP-BACKSLASH.6
SYNTAX.SHARP-BACKSLASH.7 TRACE.8))
......@@ -71,7 +71,11 @@ An example on an entry:
(clrhash *id*))
(defun get-hash-table (test)
(getf `(doit ,*doit* compileit ,*compileit*) 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*)
......@@ -79,6 +83,9 @@ An example on an entry:
(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)))
......@@ -94,13 +101,13 @@ An example on an entry:
(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)))
(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))))))
......@@ -139,6 +146,13 @@ An example on an entry:
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)
......@@ -151,4 +165,32 @@ An example on an entry:
(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)))))
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