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<))))))