[ieeefp-tests-cvs] CVS update: ieeefp-tests/ieeefp-tests.lisp

[Raymond Toy]

Update of /project/ieeefp-tests/cvsroot/ieeefp-tests
In directory common-lisp.net:/tmp/cvs-serv19142

Modified Files:
	ieeefp-tests.lisp 
Log Message:
o Add support for hypot.  This is used to test Lisp's ABS function on
  complex values.
o Clean up some comments, remove FIXME about atan2, log10, hypot.

Date: Tue Jun 15 15:23:29 2004
Author: rtoy

Index: ieeefp-tests/ieeefp-tests.lisp
diff -u ieeefp-tests/ieeefp-tests.lisp:1.5 ieeefp-tests/ieeefp-tests.lisp:1.6
--- ieeefp-tests/ieeefp-tests.lisp:1.5	Tue Jun 15 15:03:48 2004
+++ ieeefp-tests/ieeefp-tests.lisp	Tue Jun 15 15:23:29 2004
@@ -10,6 +10,11 @@
 (defun log10 (x)
   (log x (float 10 x)))
 
+;; So we can run hypot tests and make it test Lisp's ABS function on
+;; complex values.
+(defun hypot (x y)
+  (abs (complex x y)))
+
 (defclass test-vector ()
   ((fun-name :initarg :fun-name :accessor fun-name)
    (lisp-fun-name :accessor lisp-fun-name)
@@ -24,18 +29,18 @@
 (defmethod initialize-instance :after ((vector test-vector)
 				       &key args-and-expected-answer)
   (ecase (fun-name vector)
-    ;; FIXME: atan comes in two versions; log10 exists; then there's
-    ;; hypot() and cabs() which appear not to have equivalents in CL.
-    ;; (Could use them to test ABS on complexes, though)
     ((log exp sin cos tan sinh cosh tanh asin acos atan sqrt fabs floor ceil log10)
      (assert (= (length args-and-expected-answer) 2))
      (setf (fun-arity vector) 1))
-    ((add sub mul div pow atan2)
+    ((add sub mul div pow atan2 hypot)
      (assert (= (length args-and-expected-answer) 3))
      (setf (fun-arity vector) 2)))
   (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
+  ;; to use.
   (setf (fun-name vector)
 	(case (fun-name vector)
 	  ((fabs) 'abs)
@@ -54,14 +59,6 @@
   ;; be atan, overwriting the tests for the single arg atan.
   (setf (lisp-fun-name vector)
 	(case (fun-name vector)
-	  ((fabs) 'abs)
-	  ((floor) 'ffloor)
-	  ((ceil) 'fceiling)
-	  ((add) '+)
-	  ((sub) '-)
-	  ((mul) '*)
-	  ((div) '/)
-	  ((pow) 'expt)
 	  ((atan2) 'atan)
 	  (t (fun-name vector)))))
 
@@ -411,11 +408,11 @@
 
 (dolist (fun '(log sin cos tan sinh cosh tanh asin acos
 	       atan sqrt fabs floor ceil add sub mul div pow
-	       atan2 log10))
+	       atan2 log10 hypot))
   (dolist (type *float-types*)
     (pushnew (make-one-test-file fun type) *test-files* :test #'equal)))
 
-(defvar *revision* "$Revision: 1.5 $")
+(defvar *revision* "$Revision: 1.6 $")
 
 (defun format-date (stream arg colonp atp)
   (declare (ignore colonp atp))