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

Modified Files: ieeefp-tests.lisp Log Message: Modify the :eq tests so that it's easier to tell what's happening.

The expected result is the actual bit pattern. We also try to replace the actual result with one of the special values to make it easier to see what's happening too.

Date: Thu Aug 25 18:49:24 2005 Author: rtoy

Index: ieeefp-tests/ieeefp-tests.lisp diff -u ieeefp-tests/ieeefp-tests.lisp:1.11 ieeefp-tests/ieeefp-tests.lisp:1.12 --- ieeefp-tests/ieeefp-tests.lisp:1.11 Mon Aug 2 14:54:12 2004 +++ ieeefp-tests/ieeefp-tests.lisp Thu Aug 25 18:49:17 2005 @@ -203,7 +203,7 @@ (defun make-double-result-test-form (vector) `(let ((result-bits (double-float-bits result))) ,(ecase (test vector) - (:eq `(= result-bits ,(expected-answer vector))) + (:eq '(maybe-replace-special-value result-bits)) (:uo `(= (logand +quiet-double-float-nan-mask+ result-bits) +quiet-double-float-nan-mask+)) ((:vn :nb) @@ -236,7 +236,7 @@ (defun make-single-result-test-form (vector) `(let ((result-bits (single-float-bits result))) ,(ecase (test vector) - (:eq `(= result-bits ,(expected-answer vector))) + (:eq '(maybe-replace-special-value result-bits)) (:uo `(= (logand result-bits +quiet-single-float-nan-mask+) +quiet-single-float-nan-mask+)) ((:vn :nb) @@ -266,6 +266,11 @@ (logand result-bits #x7fffffff) (logand ,(expected-answer vector) #x7fffffff)))))))))

+(defun make-expected-result-form (vector) + (if (eq (test vector) :eq) + (expected-answer vector) + t)) + (defun make-test-name (vector type) (intern (format nil "~@:(~A~)-~@:(~A~)-~@:(~A~).~D" (precision vector) @@ -298,7 +303,7 @@ `(make-double-float ,x)) (fun-args vector))))) ,(make-result-test-form vector))) - t) + ,(make-expected-result-form vector)) stream)))

(defun emit-single-value-tests (vector stream) @@ -314,7 +319,7 @@ `(make-single-float ,x)) (fun-args vector))))) ,(make-result-test-form vector))) - t) + ,(make-expected-result-form vector)) stream)))

(defun emit-double-exceptions-tests (vector stream) @@ -420,7 +425,7 @@ (dolist (type *float-types*) (pushnew (make-one-test-file fun type) *test-files* :test #'equal)))

-(defvar *revision* "$Revision: 1.11 $") +(defvar *revision* "$Revision: 1.12 $")

(defun format-date (stream arg colonp atp) (declare (ignore colonp atp))