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