From c7a4509f2aeba703f2b23b67f0ff29e79379bbc5 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 29 Jan 2008 19:24:20 +0000 Subject: [PATCH] o (format nil "~9,3,2,-2,'%@E" 1100.0) was printing %%%%%%. It should print "+.001e+06" o Major changes for ~g. See the comments in format-general-aux for more details. - ~g will choose ~e more often now, especially for large numbers. - ~g when using ~F as the output format won't overflow if the number has lots of significant digits. - Excessive number of digits has been suppressed. - The original d value is used for ~g, instead of the computed value. Here is the test suite used. All tests passed. (assert (string= (format nil "~9,3,2,0,'%G" 0.0314159) "0.314e-01")) (assert (string= (format nil "~9,3,2,-2,'%@e" 3.14159) "+.003e+03")) (assert (string= (format nil "~6,2,1,'*F" 3.14159) " 31.42")) (assert (string= (format nil "~9,0,6f" 3.14159) " 3141590.")) ;; Make sure a significant digit is printed with the bad choice of ;; scale factor. Width is exceeded. (assert (string= (format nil "~9,4,,-7E" pi) ".00000003d+8")) (assert (string= (format nil "~9,4,,-5E" pi) ".000003d+6")) (assert (string= (format nil "~5,4,,7E" pi) "3141600.d-6")) (assert (string= (format nil "~11,4,,3E" pi) " 314.16d-2")) (assert (string= (format nil "~11,4,,5E" pi) " 31416.d-4")) (assert (string= (format nil "~11,4,,0E" pi) " 0.3142d+1")) (assert (string= (format nil "~9,,,-1E" pi) ".03142d+2")) (assert (string= (format nil "~,,,-2E" pi) "0.003141592653589793d+3")) (assert (string= (format nil "~,,,2E" pi) "31.41592653589793d-1")) (assert (string= (format nil "~E" pi) "3.141592653589793d+0")) (assert (string= (format nil "~9,5,,-1E" pi) ".03142d+2")) (assert (string= (format nil "~11,5,,-1E" pi) " 0.03142d+2")) (assert (string= (format nil "~G" pi) "3.141592653589793 ")) ;; This test exceeds the specified width, unnecessarily. ;;(assert (string= (format nil "~9,5G" pi) "3.1416 ")) (assert (string= (format nil "~9,5G" pi) "3.142 ")) (assert (string= (format nil "|~13,6,2,7E|" pi) "| 3141593.d-06|")) (assert (string= (format nil "~9,3,2,0,'%E" pi) "0.314d+01")) (assert (string= (format nil "~9,0,6f" pi) " 3141593.")) (assert (string= (format nil "~6,2,1,'*F" pi) " 31.42")) (assert (string= (format nil "~6,2,1,'*F" (* 100 pi)) "******")) (assert (string= (format nil "~9,3,2,-2,'%@E" pi) "+.003d+03")) (assert (string= (format nil "~10,3,2,-2,'%@E" pi) "+0.003d+03")) (assert (string= (format nil "~15,3,2,-2,'%,'=@E" pi) "=====+0.003d+03")) (assert (string= (format nil "~9,3,2,-2,'%E" pi) "0.003d+03")) (assert (string= (format nil "~8,3,2,-2,'%@E" pi) "%%%%%%%%")) (assert (string= (format nil "~g" 1e0) "1. ")) ;; This test is one interpration of the spec. We don't use this. ;;(assert (string= (format nil "~g" 1.2d40) "12000000000000000000000000000000000000000. ")) (assert (string= (format nil "~g" 1.2d40) "1.2d+40")) (assert (string= (format nil "~e" 0) "0.0e+0")) (assert (string= (format nil "~e" 0d0) "0.0d+0")) (assert (string= (format nil "~9,,4e" 0d0) "0.0d+0000")) (assert (string= (format nil "~E" 1.234567890123456789d4) "1.2345678901234567d+4")) (assert (string= (format nil "~20E" (expt 2d0 120)) "1.32922799578492d+36")) (assert (string= (format nil "~21,8E" (expt 2d0 120)) " 1.32922800d+36")) (assert (string= (format nil "~9,,,-2E" 1.2345689d3) ".00123d+6")) (assert (string= (format nil "~9,,,-2E" -1.2345689d3) "-.0012d+6")) (assert (string= (format nil "~9,,,-2E" 1.2345689d-3) ".00123d+0")) (assert (string= (format nil "~9,,,-2E" -1.2345689d-3) "-.0012d+0")) ;; Trac ticket #12: (assert (string= (format nil "~10,1,2,0,'*,,'DE" 1d-6) " 0.1D-05")) (assert (string= (format nil "~11f" 1.23456789123456789d-3) ".0012345679")) ;; Don't overflow (assert (string= (format nil "~12,,,,'%g" 1.2345678d1) "12.34568 ")) ;; From CLH 22.3.11 (defun test-f (x) (format nil "~6,2F|~6,2,1,'*F|~6,2,,'?F|~6F|~,2F|~F" x x x x x x)) (assert (string= (test-f 3.14159) " 3.14| 31.42| 3.14|3.1416|3.14|3.14159")) (assert (string= (test-f -3.14159) " -3.14|-31.42| -3.14|-3.142|-3.14|-3.14159" )) (assert (string= (test-f 100.0) "100.00|******|100.00| 100.0|100.00|100.0")) (assert (string= (test-f 1234.0) "1234.00|******|??????|1234.0|1234.00|1234.0")) (assert (string= (test-f 0.006) " 0.01| 0.06| 0.01| 0.006|0.01|0.006")) (defun test-e (x) (format nil "~9,2,1,,'*E|~10,3,2,2,'?,,'$E|~ ~9,3,2,-2,'%@E|~9,2E" x x x x)) (assert (string= (test-e 3.14159) " 3.14e+0| 31.42$-01|+.003e+03| 3.14e+0")) (assert (string= (test-e -3.14159) " -3.14e+0|-31.42$-01|-.003e+03| -3.14e+0")) (assert (string= (test-e 1100.0) " 1.10e+3| 11.00$+02|+.001e+06| 1.10e+3")) (assert (string= (test-e 1100.0d0) " 1.10d+3| 11.00$+02|+.001d+06| 1.10d+3")) (assert (string= (test-e 1.1e13) "*********| 11.00$+12|+.001e+16| 1.10e+13")) (assert (string= (test-e 1.1d120) "*********|??????????|%%%%%%%%%|1.10d+120")) (defun test-g (x) (format nil "~9,2,1,,'*G|~9,3,2,3,'?,,'$G|~9,3,2,0,'%G|~9,2G" x x x x)) (assert (string= (test-g 0.0314159) " 3.14e-2|314.2$-04|0.314e-01| 3.14e-2")) (assert (string= (test-g 0.314159) " 0.31 |0.314 |0.314 | 0.31 ")) (assert (string= (test-g 3.14159) " 3.1 | 3.14 | 3.14 | 3.1 ")) (assert (string= (test-g 31.4159) " 31. | 31.4 | 31.4 | 31. ")) (assert (string= (test-g 314.159) " 3.14e+2| 314. | 314. | 3.14e+2")) (assert (string= (test-g 3141.59) " 3.14e+3|314.2$+01|0.314e+04| 3.14e+3")) (assert (string= (test-g 3141.59d0) " 3.14d+3|314.2$+01|0.314d+04| 3.14d+3")) (assert (string= (test-g 3.14e12) "*********|314.0$+10|0.314e+13| 3.14e+12")) (assert (string= (test-g 3.14d120) "*********|?????????|%%%%%%%%%|3.14d+120")) (defun test-scale (k) (format nil "~&Scale factor ~2D: |~13,6,2,VE|" (- k 5) (- k 5) 3.14159)) (assert (string= (test-scale 0) "Scale factor -5: | 0.000003e+06|")) (assert (string= (test-scale 1) "Scale factor -4: | 0.000031e+05|")) (assert (string= (test-scale 2) "Scale factor -3: | 0.000314e+04|")) (assert (string= (test-scale 3) "Scale factor -2: | 0.003142e+03|")) (assert (string= (test-scale 4) "Scale factor -1: | 0.031416e+02|")) (assert (string= (test-scale 5) "Scale factor 0: | 0.314159e+01|")) (assert (string= (test-scale 6) "Scale factor 1: | 3.141590e+00|")) (assert (string= (test-scale 7) "Scale factor 2: | 31.41590e-01|")) (assert (string= (test-scale 8) "Scale factor 3: | 314.1590e-02|")) (assert (string= (test-scale 9) "Scale factor 4: | 3141.590e-03|")) (assert (string= (test-scale 10) "Scale factor 5: | 31415.90e-04|")) (assert (string= (test-scale 11) "Scale factor 6: | 314159.0e-05|")) (assert (string= (test-scale 12) "Scale factor 7: | 3141590.e-06|")) --- code/format.lisp | 58 ++++++++++++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 24 deletions(-) diff --git a/code/format.lisp b/code/format.lisp index c386d352b..ec85e0d27 100644 --- a/code/format.lisp +++ b/code/format.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.77 2008/01/28 22:58:43 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.78 2008/01/29 19:24:20 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1310,15 +1310,10 @@ (format t "spaceleft = ~A~%" spaceleft) (format t "expt = ~S~%" expt)) - ;; For fdig, use the larger of fdig and expt so that we'll - ;; always get at least one digit, even if the scale factor - ;; would have shifted all significant bits out. (multiple-value-bind (fstr flen lpoint tpoint) (lisp::flonum-to-string (abs number) spaceleft - (if (and fdig k (minusp k)) - (max expt fdig) - fdig) + fdig k fmin num-expt) @@ -1423,19 +1418,22 @@ (or (float-infinity-p number) (float-nan-p number))) (prin1 number stream) - ;;(multiple-value-bind (ignore n) - ;; (lisp::scale-exponent (abs number)) - (let* ((n (accurate-scale-exponent (abs number)))) - ;;Default d if omitted. The procedure is taken directly - ;;from the definition given in the manual, and is not - ;;very efficient, since we generate the digits twice. - ;;Future maintainers are encouraged to improve on this. + (let* ((n (accurate-scale-exponent (abs number))) + (orig-d d)) + ;; Default d if omitted. The procedure is taken directly from + ;; the definition given in the manual (CLHS 22.3.3.3), and is + ;; not very efficient, since we generate the digits twice. + ;; Future maintainers are encouraged to improve on this. + ;; + ;; It's also not very clear whether q in the spec is the + ;; number of significant digits or not. I (rtoy) think it + ;; makes more sense if q is the number of significant digits. + ;; That way 1d300 isn't printed as 1 followed by 300 zeroes. + ;; Exponential notation would be used instead. + (unless d - (multiple-value-bind (str len) - (lisp::flonum-to-string (abs number)) - (declare (ignore str)) - (let ((q (if (= len 1) 1 (1- len)))) - (setq d (max q (min n 7)))))) + (let* ((q (length (nth-value 1 (lisp::flonum-to-digits (abs number)))))) + (setq d (max q (min n 7))))) (let* ((ee (if e (+ e 2) 4)) (ww (if w (- w ee) nil)) (dd (- d n))) @@ -1446,13 +1444,25 @@ (format t "ww = ~A~%" ww) (format t "dd = ~A~%" dd)) (cond ((<= 0 dd d) - (let ((char (if (format-fixed-aux stream number ww dd nil - ovf pad atsign) - ovf - #\space))) + ;; Figure out how many fraction digits we really want + ;; to print. If we can, use dd. If not, adjust it + ;; so that we print as many fraction digits as + ;; possible without exceeding the width constraint, + ;; if any. + (let* ((ndigits (max 0 (if ww + (min dd (- ww 1 n)) + dd))) + (char (if (format-fixed-aux stream number ww + ndigits + nil + ovf pad atsign) + ovf + #\space))) (dotimes (i ee) (write-char char stream)))) (t - (format-exp-aux stream number w d e (or k 1) + (format-exp-aux stream number w + orig-d + e (or k 1) ovf pad marker atsign))))))) (def-format-directive #\$ (colonp atsignp params) -- GitLab