[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.lisp

[Christophe Rhodes]

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests
In directory common-lisp.net:/tmp/cvs-serv22910

Modified Files:
	ieeefp-tests.lisp 
Log Message:
Add rudimentary report generation.

Date: Tue Jun  8 07:13:26 2004
Author: crhodes

Index: ieeefp-tests/ieeefp-tests.lisp
diff -u ieeefp-tests/ieeefp-tests.lisp:1.1 ieeefp-tests/ieeefp-tests.lisp:1.2
--- ieeefp-tests/ieeefp-tests.lisp:1.1	Mon Jun  7 15:16:30 2004
+++ ieeefp-tests/ieeefp-tests.lisp	Tue Jun  8 07:13:26 2004
@@ -321,4 +321,39 @@
 (dolist (fun '(log sin cos tan sinh cosh tanh asin acos
 	       atan sqrt fabs floor ceil add sub mul div pow))
   (pushnew (make-one-test-file fun :single) *test-files* :test #'equal)
-  (pushnew (make-one-test-file fun :double) *test-files* :test #'equal))
\ No newline at end of file
+  (pushnew (make-one-test-file fun :double) *test-files* :test #'equal))
+
+(defvar *revision* "$Revision: 1.2 $")
+
+(defun format-date (stream arg colonp atp)
+  (declare (ignore colonp atp))
+  (multiple-value-bind (s m h da mo yr dow dst tz)
+      (decode-universal-time arg)
+    (declare (ignore dow))
+    (let* ((tz (+ (if dst 1 0) tz)))
+      (multiple-value-bind (tzh tzm)
+	  (truncate tz)
+	(let ((tzmm (truncate tzm 1/60)))
+	  (format stream "~2,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D~:[+~;-~]~2,'0D:~2,'0D"
+		  yr mo da h m s (minusp tzh) tzh tzmm))))))
+
+(defun report (&optional (stream *standard-output*))
+  (let ((*standard-output* stream))
+    (format t ";;;; IEEEFP-TESTS results for ~A ~A~%;;;~%"
+	    (lisp-implementation-type) (lisp-implementation-version))
+    (format t ";;; Machine: ~A ~A (~A)~%"
+	    (machine-type) (machine-version) (machine-instance))
+    ;; KLUDGE: no way of querying for libm version...
+    (format t ";;; Software: ~A ~A~%"
+	    (software-type) (software-version))
+    (format t ";;; Report generated: ~/ieeefp-tests::format-date/~%"
+	    (get-universal-time))
+    (let ((revision (subseq *revision* 11 (1- (length *revision*)))))
+      (format t ";;; using ieeefp-tests.lisp version ~A~%" revision))
+    (let ((failures (rt:pending-tests)))
+      (format t ";;;~%;;; ~D out of ~D tests failed.~%;;; Failures:~%(~%"
+	      (length failures)
+	      ;; KLUDGE: unexported symbol
+	      (length (cdr rt::*entries*)))
+      (with-standard-io-syntax
+	(format t "~{~A~%~})~%" (sort (copy-list failures) #'string<))))))