Update of /cvsroot/sbcl/sbcl/tests
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv1164/tests
Modified Files:
arith.pure.lisp
Log Message:
0.8.19.23:
Optimize float/fixnum comparisons, primarily for the benefit
of McCLIM. If the fixnum's value is in a range where it's
guaranteed to have an exact float representation, coerce it to
a float and do a float comparison. Otherwise fall back to the
old behaviour of rationalizing the float.
Index: arith.pure.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/tests/arith.pure.lisp,v
retrieving revision 1.25
retrieving revision 1.26
diff -u -d -r1.25 -r1.26
--- arith.pure.lisp 6 Jan 2005 12:48:04 -0000 1.25
+++ arith.pure.lisp 11 Feb 2005 07:32:53 -0000 1.26
@@ -224,3 +224,37 @@
(frob /)
(frob floor)
(frob ceiling))
+
+;; Check that the logic in SB-KERNEL::BASIC-COMPARE for doing fixnum/float
+;; comparisons without rationalizing the floats still gives the right anwers
+;; in the edge cases (had a fencepost error).
+(macrolet ((test (range type sign)
+ `(let (ints
+ floats
+ (start (- ,(find-symbol (format nil
+ "MOST-~A-EXACTLY-~A-FIXNUM"
+ sign type)
+ :sb-kernel)
+ ,range)))
+ (dotimes (i (1+ (* ,range 2)))
+ (let* ((x (+ start i))
+ (y (coerce x ',type)))
+ (push x ints)
+ (push y floats)))
+ (dolist (i ints)
+ (dolist (f floats)
+ (dolist (op '(< <= = >= >))
+ (unless (eq (funcall op i f)
+ (funcall op i (rationalize f)))
+ (error "(not (eq (~a ~a ~f) (~a ~a ~a)))~%"
+ op i f
+ op i (rationalize f)))
+ (unless (eq (funcall op f i)
+ (funcall op (rationalize f) i))
+ (error "(not (eq (~a ~f ~a) (~a ~a ~a)))~%"
+ op f i
+ op (rationalize f) i))))))))
+ (test 32 double-float negative)
+ (test 32 double-float positive)
+ (test 32 single-float negative)
+ (test 32 single-float positive))
|