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

[ieeefp-tests-cvs] CVS update: ieeefp-tests/Notes
by rtoy＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests In directory common-lisp.net:/tmp/cvs-serv15937 Added Files: Notes Log Message: Initial revision. Date: Thu Aug 25 20:05:25 2005 Author: rtoy

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-cmucl.lisp
by rtoy＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv15864/ieee754 Modified Files: ieee754-cmucl.lisp Log Message: Cargo cult the macrolet from ieee754-sbcl.lisp to get ieee754:= defined. Date: Thu Aug 25 20:04:17 2005 Author: rtoy Index: ieeefp-tests/ieee754/ieee754-cmucl.lisp diff -u ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.4 ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.5 --- ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.4 Thu Aug 25 18:43:41 2005 +++ ieeefp-tests/ieee754/ieee754-cmucl.lisp Thu Aug 25 20:04:17 2005 @@ -108,3 +108,23 @@ (incf f) (decf f)) (* s (scale-float (float f x) e)))))) + +(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 (ext:float-nan-p x) (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
by rtoy＠common-lisp.net 25 Aug '05

25 Aug '05

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

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-cmucl.lisp
by rtoy＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv10146/ieee754 Modified Files: ieee754-cmucl.lisp Log Message: Add get-floating-point-modes. Date: Thu Aug 25 18:43:43 2005 Author: rtoy Index: ieeefp-tests/ieee754/ieee754-cmucl.lisp diff -u ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.3 ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.4 --- ieeefp-tests/ieee754/ieee754-cmucl.lisp:1.3 Thu Jun 17 19:45:50 2004 +++ ieeefp-tests/ieee754/ieee754-cmucl.lisp Thu Aug 25 18:43:41 2005 @@ -30,6 +30,9 @@ precision)) (apply #'ext:set-floating-point-modes args)) +(defun get-floating-point-modes () + (ext:get-floating-point-modes)) + ;;; IEEE754 recommended functions

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-abcl.lisp
by pgraves＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv4938 Modified Files: ieee754-abcl.lisp Log Message: Single float support, comparison operators. Date: Thu Aug 25 17:27:45 2005 Author: pgraves Index: ieeefp-tests/ieee754/ieee754-abcl.lisp diff -u ieeefp-tests/ieee754/ieee754-abcl.lisp:1.3 ieeefp-tests/ieee754/ieee754-abcl.lisp:1.4 --- ieeefp-tests/ieee754/ieee754-abcl.lisp:1.3 Tue Jun 15 21:58:31 2004 +++ ieeefp-tests/ieee754/ieee754-abcl.lisp Thu Aug 25 17:27:45 2005 @@ -1,27 +1,48 @@ (in-package "IEEE754-INTERNALS") -(defvar ieeefp-tests:*float-types* (list :double)) +(defvar ieeefp-tests:*float-types* (list :single :double)) (defvar ieeefp-tests:*rounding-modes* (list :nearest)) (defun make-single-float (x) - (error "Not supported.")) + (sys:make-single-float x)) (defun make-double-float (x) - (sys::make-double-float x)) + (sys:make-double-float x)) (defun single-float-bits (x) - (error "Not supported.")) + (declare (type single-float x)) + (ldb (byte 32 0) (sys:single-float-bits x))) (defun double-float-bits (x) (declare (type double-float x)) (ldb (byte 64 0) - (logior (ash (sys::double-float-high-bits x) 32) - (sys::double-float-low-bits x)))) + (logior (ash (sys:double-float-high-bits x) 32) + (sys:double-float-low-bits x)))) (defun set-floating-point-modes (&rest args &key traps accrued-exceptions current-exceptions rounding-mode precision) - (declare (ignore traps accrued-exceptions current-exceptions rounding-mode - precision)) + (declare (ignore args traps accrued-exceptions current-exceptions + rounding-mode precision)) ;; Not supported. ) + +(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 (sys:float-nan-p x) (sys: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