[armedbear-cvs] r13401 - trunk/abcl/test/lisp/ansi

mevenson at common-lisp.net mevenson at common-lisp.net
Thu Jul 14 14:10:12 UTC 2011


Author: mevenson
Date: Thu Jul 14 07:10:11 2011
New Revision: 13401

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

Added test results between 0.25.0 and 0.26.0 on Solaris.

Modified:
   trunk/abcl/test/lisp/ansi/ansi-test-failures
   trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp

Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures
==============================================================================
--- trunk/abcl/test/lisp/ansi/ansi-test-failures	Wed Jul 13 12:11:11 2011	(r13400)
+++ trunk/abcl/test/lisp/ansi/ansi-test-failures	Thu Jul 14 07:10:11 2011	(r13401)
@@ -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))
+
+
+
+

Modified: trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp
==============================================================================
--- trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp	Wed Jul 13 12:11:11 2011	(r13400)
+++ trunk/abcl/test/lisp/ansi/parse-ansi-errors.lisp	Thu Jul 14 07:10:11 2011	(r13401)
@@ -71,7 +71,11 @@
   (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 @@
       (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 @@
             (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 @@
                                                       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 @@
           (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)))))
+
+      
+    
+  
+    
         




More information about the armedbear-cvs mailing list