From 686a18ac8ea4b579af9ad5ee4e8b42af5f5476bc Mon Sep 17 00:00:00 2001
From: rtoy <rtoy>
Date: Wed, 3 Oct 2007 20:59:30 +0000
Subject: [PATCH] Fix for Trac ticket #1.

Instead of having scale-exponent scale the number and using the scaled
number for printing, have flonum-to-string scale the number for us.
There is no loss in precision in flonum-to-string, so we don't have
round-off errors in printing the number.  This means (format nil "~E"
1.234567890123456789d4) is printed as "1.2345678901234567d+4" instead
of "1.2345678901234565d+0".  Then prin1 and ~E both call
flonum-to-digits with exactly the same number, so prin1 and ~E should
have the same printed result.

These tests pass:

(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+0"))
---
 code/format.lisp | 43 ++++++++++++++++++++++++++++++++++++-------
 1 file changed, 36 insertions(+), 7 deletions(-)

diff --git a/code/format.lisp b/code/format.lisp
index 4716c9c9d..c72ed03bf 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.70 2006/06/30 18:41:22 rtoy Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/format.lisp,v 1.71 2007/10/03 20:59:30 rtoy Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -1196,7 +1196,7 @@
 ;;;Here we prevent the scale factor from shifting all significance out of
 ;;;a number to the right.  We allow insignificant zeroes to be shifted in
 ;;;to the left right, athough it is an error to specify k and d such that this
-;;;occurs.  Perhaps we should detect both these condtions and flag them as
+;;;occurs.  Perhaps we should detect both these conditions and flag them as
 ;;;errors.  As for now, we let the user get away with it, and merely guarantee
 ;;;that at least one significant digit will appear.
 
@@ -1212,6 +1212,7 @@
       (prin1 number stream)
       (multiple-value-bind (num expt)
 	  (lisp::scale-exponent (abs number))
+	(declare (ignore num))
 	(let* ((expt (- expt k))
 	       (estr (decimal-string (abs expt)))
 	       (elen (if e (max (length estr) e) (length estr)))
@@ -1219,17 +1220,44 @@
 	  (if (and w ovf e (> elen e)) ;exponent overflow
 	      (dotimes (i w)
 		(write-char ovf stream))
+	      ;; The hairy case
 	      (let* ((fdig (if d (if (plusp k) (1+ (- d k)) d) nil))
-		     (fmin (if (minusp k)
-			       1
-			       fdig))
+		     (fmin (if (<= k 0)
+			       (if d (+ d k -1) (- k))
+			       nil))
 		     (spaceleft (if w
 				    (- w 2 elen
 				       (if (or atsign (minusp (float-sign number)))
 					   1 0))
 				    nil)))
+		#+(or)
+		(progn
+		  (format t "fdig = ~A~%" fdig)
+		  (format t "fmin = ~A~%" fmin)
+		  (format t "spaceleft = ~A~%" spaceleft)
+		  (format t "exp  = ~A~%" exp)
+		  (format t "expt = ~S~%" expt))
+
+		;; 1 extra for spaceleft so (format nil "~9,,,-1E" pi) will
+		;; produce ".03142d+2" instead of "0.0314d+2".
+		;;
+		;; 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 num spaceleft fdig k fmin)
+		    (lisp::flonum-to-string (abs number)
+					    (if spaceleft (1+ spaceleft))
+					    (if fdig
+						(max fdig expt))
+					    (- expt)
+					    fmin)
+		  #+(or)
+		  (progn
+		    (format t "fstr = ~S~%" fstr)
+		    (format t "flen = ~S~%" flen)
+		    (format t "lp   = ~S~%" lpoint)
+		    (format t "tp   = ~S~%" tpoint))
+
 		  (when (and d (zerop d)) (setq tpoint nil))
 		  (when w 
 		    (decf spaceleft flen)
@@ -1281,7 +1309,8 @@
 			     ;;zero-fill before exponent if necessary
 			     (dotimes (i (- e (length estr)))
 			       (write-char #\0 stream)))
-			   (write-string estr stream))))))))))
+			   (write-string estr stream)))))))))
+      (values)))
 
 (def-format-directive #\G (colonp atsignp params)
   (when colonp
-- 
GitLab