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