- ieeefp-tests-cvs@common-lisp.net - mailman3.common-lisp.net

[ieeefp-tests-cvs] CVS update: ieeefp-tests/package.lisp
by Peter Graves 09 Jun '04

09 Jun '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests In directory common-lisp.net:/tmp/cvs-serv11184 Modified Files: package.lisp Log Message: Export *FLOAT-TYPES* and *ROUNDING-MODES* from IEEE754 package. Date: Wed Jun 9 08:53:42 2004 Author: pgraves Index: ieeefp-tests/package.lisp diff -u ieeefp-tests/package.lisp:1.1 ieeefp-tests/package.lisp:1.2 --- ieeefp-tests/package.lisp:1.1 Mon Jun 7 15:16:30 2004 +++ ieeefp-tests/package.lisp Wed Jun 9 08:53:42 2004 @@ -1,6 +1,7 @@ (defpackage "IEEE754" (:use "CL") - (:export "MAKE-SINGLE-FLOAT" "MAKE-DOUBLE-FLOAT" + (:export "*FLOAT-TYPES*" "*ROUNDING-MODES*" + "MAKE-SINGLE-FLOAT" "MAKE-DOUBLE-FLOAT" "SINGLE-FLOAT-BITS" "DOUBLE-FLOAT-BITS" "SET-FLOATING-POINT-MODES"))

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.asd
by Peter Graves 09 Jun '04

09 Jun '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests In directory common-lisp.net:/tmp/cvs-serv10306 Modified Files: ieeefp-tests.asd Log Message: Added support for ABCL. Date: Wed Jun 9 08:51:44 2004 Author: pgraves Index: ieeefp-tests/ieeefp-tests.asd diff -u ieeefp-tests/ieeefp-tests.asd:1.2 ieeefp-tests/ieeefp-tests.asd:1.3 --- ieeefp-tests/ieeefp-tests.asd:1.2 Tue Jun 8 06:49:26 2004 +++ ieeefp-tests/ieeefp-tests.asd Wed Jun 9 08:51:44 2004 @@ -7,7 +7,9 @@ ((:file "ieee754-sbcl" :in-order-to ((compile-op (feature :sbcl)))) (:file "ieee754-cmucl" - :in-order-to ((compile-op (feature :cmu))))) + :in-order-to ((compile-op (feature :cmu)))) + (:file "ieee754-abcl" + :in-order-to ((compile-op (feature :abcl))))) :if-component-dep-fails :ignore) (:file "ieeefp-tests" :depends-on ("ieee754"))))

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-abcl.lisp
by Peter Graves 09 Jun '04

09 Jun '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv9954 Added Files: ieee754-abcl.lisp Log Message: Initial checkin. Date: Wed Jun 9 08:51:02 2004 Author: pgraves

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.lisp
by Raymond Toy 09 Jun '04

09 Jun '04

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

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.lisp
by Christophe Rhodes 08 Jun '04

08 Jun '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests In directory common-lisp.net:/tmp/cvs-serv22910 Modified Files: ieeefp-tests.lisp Log Message: Add rudimentary report generation. Date: Tue Jun 8 07:13:26 2004 Author: crhodes Index: ieeefp-tests/ieeefp-tests.lisp diff -u ieeefp-tests/ieeefp-tests.lisp:1.1 ieeefp-tests/ieeefp-tests.lisp:1.2 --- ieeefp-tests/ieeefp-tests.lisp:1.1 Mon Jun 7 15:16:30 2004 +++ ieeefp-tests/ieeefp-tests.lisp Tue Jun 8 07:13:26 2004 @@ -321,4 +321,39 @@ (dolist (fun '(log sin cos tan sinh cosh tanh asin acos atan sqrt fabs floor ceil add sub mul div pow)) (pushnew (make-one-test-file fun :single) *test-files* :test #'equal) - (pushnew (make-one-test-file fun :double) *test-files* :test #'equal)) \ No newline at end of file + (pushnew (make-one-test-file fun :double) *test-files* :test #'equal)) + +(defvar *revision* "$Revision: 1.2 $") + +(defun format-date (stream arg colonp atp) + (declare (ignore colonp atp)) + (multiple-value-bind (s m h da mo yr dow dst tz) + (decode-universal-time arg) + (declare (ignore dow)) + (let* ((tz (+ (if dst 1 0) tz))) + (multiple-value-bind (tzh tzm) + (truncate tz) + (let ((tzmm (truncate tzm 1/60))) + (format stream "~2,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D~:[+~;-~]~2,'0D:~2,'0D" + yr mo da h m s (minusp tzh) tzh tzmm)))))) + +(defun report (&optional (stream *standard-output*)) + (let ((*standard-output* stream)) + (format t ";;;; IEEEFP-TESTS results for ~A ~A~%;;;~%" + (lisp-implementation-type) (lisp-implementation-version)) + (format t ";;; Machine: ~A ~A (~A)~%" + (machine-type) (machine-version) (machine-instance)) + ;; KLUDGE: no way of querying for libm version... + (format t ";;; Software: ~A ~A~%" + (software-type) (software-version)) + (format t ";;; Report generated: ~/ieeefp-tests::format-date/~%" + (get-universal-time)) + (let ((revision (subseq *revision* 11 (1- (length *revision*))))) + (format t ";;; using ieeefp-tests.lisp version ~A~%" revision)) + (let ((failures (rt:pending-tests))) + (format t ";;;~%;;; ~D out of ~D tests failed.~%;;; Failures:~%(~%" + (length failures) + ;; KLUDGE: unexported symbol + (length (cdr rt::*entries*))) + (with-standard-io-syntax + (format t "~{~A~%~})~%" (sort (copy-list failures) #'string<))))))

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.asd
by Raymond Toy 08 Jun '04

08 Jun '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests In directory common-lisp.net:/tmp/cvs-serv5983 Modified Files: ieeefp-tests.asd Log Message: Support for ieee754-cmucl. (I think.) Date: Tue Jun 8 06:49:26 2004 Author: rtoy Index: ieeefp-tests/ieeefp-tests.asd diff -u ieeefp-tests/ieeefp-tests.asd:1.1 ieeefp-tests/ieeefp-tests.asd:1.2 --- ieeefp-tests/ieeefp-tests.asd:1.1 Mon Jun 7 15:16:30 2004 +++ ieeefp-tests/ieeefp-tests.asd Tue Jun 8 06:49:26 2004 @@ -5,7 +5,9 @@ :depends-on ("package") :components ((:file "ieee754-sbcl" - :in-order-to ((compile-op (feature :sbcl))))) + :in-order-to ((compile-op (feature :sbcl)))) + (:file "ieee754-cmucl" + :in-order-to ((compile-op (feature :cmu))))) :if-component-dep-fails :ignore) (:file "ieeefp-tests" :depends-on ("ieee754"))))

1 0

[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieee754/ieee754-cmucl.lisp
by Raymond Toy 08 Jun '04

08 Jun '04

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests/ieee754 In directory common-lisp.net:/tmp/cvs-serv3004/ieee754 Added Files: ieee754-cmucl.lisp Log Message: CMUCL port of the ieee754 routines. Date: Tue Jun 8 06:44:43 2004 Author: rtoy

1 0