### format: add test verifying correct rounding for ~e directive

parent 52d21992
 ... ... @@ -449,3 +449,49 @@ `(with-output-to-string (,stream) (assert (equal (funcall ,fn ,stream ,@args 'a) '(a)))))) ;;; Function used in checking correct rounding for floating point printing (defun round-ratio-to-n-digits (ratio n) "Returns a string with the first n significant digits of the decimal representation of ratio." (check-type ratio rational) (check-type n (integer 1 *)) (let* ((exp (floor (* (- (integer-length (numerator ratio)) (integer-length (denominator ratio))) #.(log 2d0 10)))) (10^n (expt 10 n)) ;; We first scale the ratio down to the range ;; 10^n <= x < 10^(n+1). This allows us to use integer ;; arithmetic to compute the number below satisfying ;; below <= x <= below + 10. (x (loop with x = (/ ratio (expt 10 (- exp n))) until (<= 10^n x (* 10 10^n)) do (setf x (if (< x 10^n) (* x 10) (/ x 10))) finally (return x))) (below 10^n)) (loop for i below n with 10^n-i = below do (loop until (and (<= below x) (< x (+ below 10^n-i))) do (if (> below x) (setf below (- below 10^n-i)) (setf below (+ below 10^n-i)))) (setf 10^n-i (/ 10^n-i 10))) (let ((halfway (+ below 5))) (cond ((< x halfway) (values (write-to-string (/ below 10)))) ((> x halfway) (values (write-to-string (let ((rounded (+ (/ below 10) 1))) (if (>= rounded 10^n) (/ rounded 10) rounded))))) (t ;; "When rounding up and rounding down would ;; produce printed values equidistant from the ;; scaled value of arg, then the implementation is ;; free to use either one" (values (write-to-string (/ below 10)) (write-to-string (let ((rounded (+ (/ below 10) 1))) (if (>= rounded 10^n) (/ rounded 10) rounded)))))))))
 ... ... @@ -77,11 +77,11 @@ ;;; If the parameter d is omitted, [...] a value is chosen for d in ;;; "If the parameter d is omitted, [...] a value is chosen for d in ;;; such a way that as many digits as possible may be printed subject ;;; to [...] the constraint that no trailing zero digits may appear in ;;; the fraction, except that if the fraction to be printed is zero ;;; then a single zero digit should appear after the decimal point. ;;; then a single zero digit should appear after the decimal point." (deftest format.e.3 (let ((fn (formatter "~6e"))) ... ... @@ -397,3 +397,40 @@ unless (and (string= s "5.00^-1") (string= s s2)) collect (list x s s2))) nil) ;;; verify correct rounding (deftest format.e.26 (loop for i = (random 4) for type = (elt #(short-float single-float double-float long-float) i) for min-value = (elt (vector least-positive-short-float least-positive-single-float least-positive-double-float least-positive-long-float) i) for max-value = (elt (vector most-positive-short-float most-positive-single-float most-positive-double-float most-positive-long-float) i) ;; create a random float ... for x = (exp (+ (random (- (log max-value) (log min-value))) (log min-value))) ;; ... and check the correct rounding for as many significant ;; digits as the precision of the float allows for incorrect-roundings = (loop for d from 1 upto (floor (* (float-precision x) (log (float-radix x) 10))) for format-string = (format nil "~~,~d,,0e" d) for s1 = (let* ((*read-default-float-format* type) (s1 (format nil format-string x))) (subseq s1 (1+ (position #\. s1)) (position #\e s1))) with ret = nil do (multiple-value-bind (s2 s3) (round-ratio-to-n-digits (rationalize x) d) (unless (or (string= s1 s2) (and s3 (string= s1 s3))) (push (list x (format nil format-string x) s1 s2 s3) ret))) finally (return ret)) repeat 20 if incorrect-roundings collect incorrect-roundings) nil)
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!