Update of /project/ieeefp-tests/cvsroot/ieeefp-tests
In directory common-lisp.net:/tmp/cvs-serv13270
Modified Files:
ieeefp-tests.lisp
Log Message:
Add some constants for some well-known IEEE754 values and use them in
the constructed tests to make it easier to read and understand what
the tests are doing.
Date: Wed Jun 9 06:06:17 2004
Author: rtoy
Index: ieeefp-tests/ieeefp-tests.lisp
diff -u ieeefp-tests/ieeefp-tests.lisp:1.2 ieeefp-tests/ieeefp-tests.lisp:1.3
--- ieeefp-tests/ieeefp-tests.lisp:1.2 Tue Jun 8 07:13:26 2004
+++ ieeefp-tests/ieeefp-tests.lisp Wed Jun 9 06:06:17 2004
@@ -37,6 +37,64 @@
((pow) 'expt)
(t (fun-name vector)))))
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ ;; A bunch of constants for common IEEE values so we can read the
+ ;; tests more easily.
+ (defconstant +quiet-double-float-nan-mask+
+ #X7FF8000000000000)
+ (defconstant +quiet-single-float-nan-mask+
+ #X7FC00000)
+ (defconstant +trapping-double-float-nan+
+ #xFFF0000000000001)
+ (defconstant +single-float-positive-infinity+
+ #x7F800000)
+ (defconstant +single-float-negative-infinity+
+ #xFF800000)
+ (defconstant +double-float-positive-infinity+
+ #x7FF0000000000000)
+ (defconstant +double-float-negative-infinity+
+ #xFFF0000000000000)
+ (defconstant +most-positive-double-float+
+ #X7FEFFFFFFFFFFFFF)
+ (defconstant +most-positive-single-float+
+ #x7F7FFFFF)
+ (defconstant +1d0+
+ #x3FF0000000000000)
+ (defconstant +1f0+
+ #x3F800000)
+ (defconstant +negative-0d0+
+ #x8000000000000000)
+ (defconstant +negative-0f0+
+ #x80000000)
+ )
+
+;; An alist of integers and the corresponding symbol with that value.
+(defparameter *special-values*
+ (mapcar #'(lambda (x)
+ `(,(symbol-value x) ,x))
+ '(+quiet-double-float-nan-mask+
+ +quiet-single-float-nan-mask+
+ +trapping-double-float-nan+
+ +single-float-positive-infinity+
+ +single-float-negative-infinity+
+ +double-float-positive-infinity+
+ +double-float-negative-infinity+
+ +most-positive-double-float+
+ +most-positive-single-float+
+ +1d0+
+ +1f0+
+ +negative-0d0+
+ +negative-0f0+
+ )))
+
+
+(defun maybe-replace-special-value (x)
+ ;; Look at x and replace it with named constants, if possible.
+ (let ((value (assoc x *special-values* :test #'=)))
+ (if value
+ (cadr value)
+ x)))
+
(defun process-vector-file (function-name precision)
(let* ((file-name (format nil "~(~A~)~(~A~)" function-name
(char (symbol-name precision) 0)))
@@ -82,14 +140,15 @@
(:double #'cddr)
(:quad #'cddddr))
collect
- (ecase precision
+ (maybe-replace-special-value
+ (ecase precision
(:single (parse-integer (car x) :radix 16))
(:double (+ (ash (parse-integer (car x) :radix 16) 32)
(parse-integer (cadr x) :radix 16)))
(:quad (+ (ash (parse-integer (car x) :radix 16) 96)
(ash (parse-integer (cadr x) :radix 16) 64)
(ash (parse-integer (caddr x) :radix 16) 32)
- (parse-integer (cadddr x) :radix 16))))))
+ (parse-integer (cadddr x) :radix 16)))))))
(push (make-instance 'test-vector
:fun-name function-name
:precision precision
@@ -119,7 +178,8 @@
`(let ((result-bits (double-float-bits result)))
,(ecase (test vector)
(:eq `(= result-bits ,(expected-answer vector)))
- (:uo `(= (logand #x7ff8000000000000 result-bits) #x7ff8000000000000))
+ (:uo `(= (logand +quiet-double-float-nan-mask+ result-bits)
+ +quiet-double-float-nan-mask+))
((:vn :nb)
`(<= (abs (- ,(expected-answer vector) result-bits))
,(if (eq (test vector) :vn) 3 10)))
@@ -151,7 +211,8 @@
`(let ((result-bits (single-float-bits result)))
,(ecase (test vector)
(:eq `(= result-bits ,(expected-answer vector)))
- (:uo `(= (logand result-bits #x7fc00000) #x7fc00000))
+ (:uo `(= (logand result-bits +quiet-single-float-nan-mask+)
+ +quiet-single-float-nan-mask+))
((:vn :nb)
`(<= (abs (- ,(expected-answer vector) result-bits))
,(if (eq (test vector) :vn) 3 10)))
@@ -323,7 +384,7 @@
(pushnew (make-one-test-file fun :single) *test-files* :test #'equal)
(pushnew (make-one-test-file fun :double) *test-files* :test #'equal))
-(defvar *revision* "$Revision: 1.2 $")
+(defvar *revision* "$Revision: 1.3 $")
(defun format-date (stream arg colonp atp)
(declare (ignore colonp atp))