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