August 2004 - ieeefp-tests-cvs@common-lisp.net

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ucb-patches/ucblib/=d.input ieeefp-tests/ucb-patches/ucblib/=s.input
by Christophe Rhodes 02 Aug '04

02 Aug '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ucb-patches/ucblib In directory common-lisp.net:/tmp/cvs-serv24641/ucb-patches/ucblib Added Files: =d.input =s.input 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:13 2004 Author: crhodes

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-sbcl.lisp
by Christophe Rhodes 02 Aug '04

02 Aug '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv24641/ieee754 Modified Files: ieee754-sbcl.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:13 2004 Author: crhodes Index: ieeefp-tests/ieee754/ieee754-sbcl.lisp diff -u ieeefp-tests/ieee754/ieee754-sbcl.lisp:1.2 ieeefp-tests/ieee754/ieee754-sbcl.lisp:1.3 --- ieeefp-tests/ieee754/ieee754-sbcl.lisp:1.2 Thu Jun 17 10:32:17 2004 +++ ieeefp-tests/ieee754/ieee754-sbcl.lisp Mon Aug 2 05:54:12 2004 @@ -1,5 +1,7 @@ (in-package "IEEE754-INTERNALS") +(defvar ieeefp-tests:*test-exceptions* t) + (defun make-single-float (x) (declare (type (or (unsigned-byte 32) (signed-byte 32)) x)) (typecase x @@ -32,3 +34,23 @@ (defun get-floating-point-modes () (sb-int:get-floating-point-modes)) + +(macrolet + ((def (x &body body) + `(defun ,x (x y) + (declare (type float x y)) + ,@body))) + (def = (cl:= x y)) + (def ?<> (not (= x y))) + (def > (cl:> x y)) + (def >= (cl:>= x y)) + (def < (cl:< x y)) + (def <= (cl:<= x y)) + (def ? (or (sb-ext:float-nan-p x) (sb-ext:float-nan-p y))) + (def <> (or (< x y) (> x y))) + (def <=> (or (< x y) (= x y) (> x y))) + (def ?> (or (? x y) (> x y))) + (def ?>= (or (? x y) (>= x y))) + (def ?< (or (? x y) (< x y))) + (def ?<= (or (? x y) (<= x y))) + (def ?= (or (? x y) (= x y))))

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.lisp ieeefp-tests/package.lisp
by Christophe Rhodes 02 Aug '04

02 Aug '04

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

1 0