From 9e71e519112746675707d17248c98f4e8d412e7f Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Fri, 25 Jan 2008 19:16:12 +0000
Subject: [PATCH] o Incorrect number of digits were printed for ~wF. o If FMIN
 is given, print out the digits, even if we're out of room.   (This is so ~E
 will print at least 1 digit due to a bad choice in   scale factor.)

The following tests all pass.

(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."))

(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    "))
(assert (string= (format nil "~9,5G" pi) "3.1416    "))
(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.    "))
;(assert (string= (format nil "~g" 1.2d40) "12000000000000000000000000000000000000000.    "))

(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 "~11f" 1.23456789123456789d-3) ".0012345679"))

;; 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-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/print.lisp | 22 +++++++++++++---------
 1 file changed, 13 insertions(+), 9 deletions(-)

diff --git a/code/print.lisp b/code/print.lisp
index 2d4b69ff8..4498fadfa 100644
--- a/code/print.lisp
+++ b/code/print.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/print.lisp,v 1.117 2008/01/24 02:20:07 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/print.lisp,v 1.118 2008/01/25 19:16:12 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1512,11 +1512,13 @@ radix-R.  If you have a power-list then pass it in as PL."
 					      num-expt))
 		   (if (and width (> width 1))
 		       (let ((w (multiple-value-list
-				 (let ((posn (- num-expt (1- width))))
+				 (let ((ndigits (1- width))
+				       (scaled (+ num-expt (or scale 0))))
+				   (when (and scale (< scale 0))
+				     (setf ndigits (- ndigits scaled 1)))
 				   (fixup-flonum-to-digits x num-expt
-							    (if (minusp posn)
-								(1+ posn)
-								posn)))))
+							   ndigits
+							   t))))
 			     (f (multiple-value-list
 				 (fixup-flonum-to-digits x num-expt
 							 (- num-expt (or fmin 0) 1)))))
@@ -1546,11 +1548,13 @@ radix-R.  If you have a power-list then pass it in as PL."
 		     (dotimes (i (- e))
 		       (write-char #\0 stream))
 		     ;; If we're out of room (because fdigits is too
-		     ;; small), don't print out our string.  This fixes
-		     ;; things like (format nil "~,2f" 0.001).  We should
-		     ;; print ".00", not ".001".
+		     ;; small), don't print out our string.  This
+		     ;; fixes things like (format nil "~,2f" 0.001).
+		     ;; We should print ".00", not ".001".  But if
+		     ;; fmin is set, we want to print out something.
 		     (when (or (null fdigits)
-			       (plusp (+ e fdigits)))
+			       (plusp (+ e fdigits))
+			       fmin)
 		       (write-string string stream))
 		     (when fdigits
 		       (dotimes (i (+ fdigits e (- (length string))))
-- 
GitLab