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

Modified Files: ieeefp-tests.lisp package.lisp Log Message: Implement for sbcl comparison operators from Table 4 of ieee754.

Work enough logic into ieeefp-tests to be able to test booleans as well as numerical results

Add test vectors for ieee754:=

Make sbcl test exceptions by default

Date: Mon Aug 2 05:54:12 2004 Author: crhodes

Index: ieeefp-tests/ieeefp-tests.lisp diff -u ieeefp-tests/ieeefp-tests.lisp:1.10 ieeefp-tests/ieeefp-tests.lisp:1.11 --- ieeefp-tests/ieeefp-tests.lisp:1.10 Thu Jun 17 10:32:17 2004 +++ ieeefp-tests/ieeefp-tests.lisp Mon Aug 2 05:54:12 2004 @@ -37,9 +37,17 @@ (setf (fun-arity vector) 1)) ((add sub mul div pow atan2 hypot) (assert (= (length args-and-expected-answer) 3)) + (setf (fun-arity vector) 2)) + ((ieee754:=) + (assert (= (length args-and-expected-answer) 2)) (setf (fun-arity vector) 2))) - (setf (fun-args vector) (butlast args-and-expected-answer)) - (setf (expected-answer vector) (car (last args-and-expected-answer))) + (case (test vector) + ((:yea :nay) + (setf (fun-args vector) args-and-expected-answer + (expected-answer vector) nil)) + (t + (setf (fun-args vector) (butlast args-and-expected-answer)) + (setf (expected-answer vector) (car (last args-and-expected-answer))))) (setf (exceptions vector) (sort (exceptions vector) #'string<)) ;; FUN-NAME is currently partially overloaded with 2 meanings: 1. It ;; is the name of the test. 2. It is the name of the Lisp function @@ -106,7 +114,7 @@

(defun vector-pathname (function-name file-name) (let ((directory (case function-name - ((trunc) '(:relative "ucb-patches" "ucblib")) + ((trunc ieee754:=) '(:relative "ucb-patches" "ucblib")) (t '(:relative "ucb" "ucblib"))))) (merge-pathnames (make-pathname :directory directory @@ -183,12 +191,14 @@ stream list)))

(defun make-result-test-form (vector) - `(if (complexp result) - t - ,(ecase (precision vector) - (:single (make-single-result-test-form vector)) - (:double (make-double-result-test-form vector)) - ))) + (case (test vector) + ((:yea) `(not (not result))) + ((:nay) `(not result)) + (t `(if (complexp result) + t + ,(ecase (precision vector) + (:single (make-single-result-test-form vector)) + (:double (make-double-result-test-form vector)))))))

(defun make-double-result-test-form (vector) `(let ((result-bits (double-float-bits result))) @@ -406,11 +416,11 @@

(dolist (fun '(log sin cos tan sinh cosh tanh asin acos atan sqrt fabs floor ceil add sub mul div pow - atan2 log10 hypot trunc)) + atan2 log10 hypot trunc ieee754:=)) (dolist (type *float-types*) (pushnew (make-one-test-file fun type) *test-files* :test #'equal)))

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

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

Index: ieeefp-tests/package.lisp diff -u ieeefp-tests/package.lisp:1.4 ieeefp-tests/package.lisp:1.5 --- ieeefp-tests/package.lisp:1.4 Thu Jun 17 10:32:17 2004 +++ ieeefp-tests/package.lisp Mon Aug 2 05:54:12 2004 @@ -1,12 +1,21 @@ (defpackage "IEEE754" (:use "CL") + (:shadow "=" ">" "<" ">=" "<=") (:export "MAKE-SINGLE-FLOAT" "MAKE-DOUBLE-FLOAT" "SINGLE-FLOAT-BITS" "DOUBLE-FLOAT-BITS" - "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES")) + "GET-FLOATING-POINT-MODES" "SET-FLOATING-POINT-MODES" + + ;; IEEE754 Table 4 + "=" "?<>" ">" ">=" "<" "<=" "?" + "<>" + "<=>" "?>" "?>=" "?<" "?<=" "?=" + ))

(defpackage "IEEE754-INTERNALS" + (:shadowing-import-from "IEEE754" "=" ">" "<" ">=" "<=") (:use "CL" "IEEE754"))

(defpackage "IEEEFP-TESTS" + (:shadowing-import-from "CL" "=" ">" "<" ">=" "<=") (:use "CL" "IEEE754" "SPLIT-SEQUENCE") (:export "*FLOAT-TYPES*" "*ROUNDING-MODES*" "*TEST-EXCEPTIONS*"))