From: Nikodemus Siivola <nikodemus@sb-studio.net>
Date: Fri, 29 Jul 2011 11:41:00 +0000 (+0300)
Subject: fixed-format floating point printing: zero and scaling factors
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=8f1d4a2508e8d81564822a1668fe30a490b9c3f6;p=sbcl.git

fixed-format floating point printing: zero and scaling factors

  Now that FLONUM-TO-DIGITS handles zero, we need to check against
  zero before adding in the scaling factor.

  Also make sure not to print extra digits when E is negative.

  Adjust FORMAT-AUX-EXP to not print the extra-zero: FLONUM-TO-STRING
  provides it now.

  Fixes lp#811386.
---

diff --git a/NEWS b/NEWS
index f8670fa..c9a087d 100644
--- a/NEWS
+++ b/NEWS
@@ -8,6 +8,8 @@ changes relative to sbcl-1.0.50:
     Marsden. (lp#816564)
   * bug fix: obsolete instance protocol fires when shared slots are added
     or removed.
+  * bug fix: fixed-format floating point printing with scaling factors.
+    (lp#811386)
 
 changes in sbcl-1.0.50 relative to sbcl-1.0.49:
   * enhancement: errors from FD handlers now provide a restart to remove
diff --git a/src/code/print.lisp b/src/code/print.lisp
index a52648a..b0a4e72 100644
--- a/src/code/print.lisp
+++ b/src/code/print.lisp
@@ -1333,7 +1333,9 @@
                    (values-list w))
                   (t (values-list f))))
               (flonum-to-digits x)))
-    (let ((e (+ e (or scale 0)))
+    (let ((e (if (zerop x)
+                 e
+                 (+ e (or scale 0))))
           (stream (make-string-output-stream)))
       (if (plusp e)
           (progn
@@ -1351,7 +1353,10 @@
             (write-string "." stream)
             (dotimes (i (- e))
               (write-char #\0 stream))
-            (write-string string stream)
+            (write-string string stream :end (when fdigits
+                                               (min (length string)
+                                                    (max (or fmin 0)
+                                                         (+ fdigits e)))))
             (when fdigits
               (dotimes (i (+ fdigits e (- (length string))))
                 (write-char #\0 stream)))))
diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 6419712..a5ef5e6 100644
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -622,14 +622,6 @@
                   (when (and d (zerop d)) (setq tpoint nil))
                   (when w
                     (decf spaceleft flen)
-                    ;; See CLHS 22.3.3.2.  "If the parameter d is
-                    ;; omitted, ... [and] if the fraction to be
-                    ;; printed is zero then a single zero digit should
-                    ;; appear after the decimal point."  So we need to
-                    ;; subtract one from here because we're going to
-                    ;; add an extra 0 digit later. [rtoy]
-                    (when (and (zerop number) (null d))
-                      (decf spaceleft))
                     (when lpoint
                       (if (or (> spaceleft 0) tpoint)
                           (decf spaceleft)
@@ -646,10 +638,6 @@
                                (if atsign (write-char #\+ stream)))
                            (when lpoint (write-char #\0 stream))
                            (write-string fstr stream)
-                           (when (and (zerop number) (null d))
-                             ;; It's later and we're adding the zero
-                             ;; digit.
-                             (write-char #\0 stream))
                            (write-char (if marker
                                            marker
                                            (format-exponent-marker number))
diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index 9c3329e..177b1ba 100644
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -562,4 +562,13 @@
                        (list f (read-from-string (prin1-to-string f))))
                      oops)))))
 
+(with-test (:name :bug-811386)
+  (assert (equal "   0.00" (format nil "~7,2,-2f" 0)))
+  (assert (equal "   0.00" (format nil "~7,2,2f" 0)))
+  (assert (equal "   0.01" (format nil "~7,2,-2f" 1)))
+  (assert (equal " 100.00" (format nil "~7,2,2f" 1)))
+  (assert (equal "   0.00" (format nil "~7,2,-2f" 0.1)))
+  (assert (equal "  10.00" (format nil "~7,2,2f" 0.1)))
+  (assert (equal "   0.01" (format nil "~7,2,-2f" 0.5))))
+
 ;;; success