clojure.contrib.pprint (cl-format): Fixes to rounding and width issue…

…s in ~f and ~$. See #47.

src/main/clojure/clojure/contrib/pprint/cl_format.clj

@@ -585,7 +585,8 @@ Note this should only be used for the last one in the sequence"
                       round-up-result (str leading-zeros
                                            (String/valueOf (+ result-val 
                                                               (if (neg? result-val) -1 1))))
-                      expanded (> (count round-up-result) (count result))]
+                      expanded (> (count round-up-result) (count result))
+                      _ (prlabel round-str round-up-result e1 expanded)]
                   [round-up-result e1 expanded])
                 [result e1 false]))
             [m e false]))
@@ -624,32 +625,34 @@ Note this should only be used for the last one in the sequence"
   (let [w (:w params)
         d (:d params)
         [arg navigator] (next-arg navigator)
-        [mantissa exp] (float-parts arg)
+        [sign abs] (if (neg? arg) ["-" (- arg)] ["+" arg])
+        [mantissa exp] (float-parts abs)
         scaled-exp (+ exp (:k params))
-        add-sign (and (:at params) (not (neg? arg)))
-        prepend-zero (< -1.0 arg 1.0)
+        add-sign (or (:at params) (neg? arg))
         append-zero (and (not d) (<= (dec (count mantissa)) scaled-exp))
-        [rounded-mantissa scaled-exp] (round-str mantissa scaled-exp 
-                                                 d (if w (- w (if add-sign 1 0))))
-        fixed-repr (get-fixed rounded-mantissa scaled-exp d)]
+        [rounded-mantissa scaled-exp expanded] (round-str mantissa scaled-exp 
+                                                          d (if w (- w (if add-sign 1 0))))
+        _ (prlabel f-f mantissa exp rounded-mantissa scaled-exp)
+        fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d)
+        prepend-zero (= (first fixed-repr) \.)]
     (if w
       (let [len (count fixed-repr)
             signed-len (if add-sign (inc len) len)
-            prepend-zero (and prepend-zero (not (= signed-len w)))
-            append-zero (and append-zero (not (= signed-len w)))
+            prepend-zero (and prepend-zero (not (>= signed-len w)))
+            append-zero (and append-zero (not (>= signed-len w)))
             full-len (if (or prepend-zero append-zero)
                        (inc signed-len) 
                        signed-len)]
         (if (and (> full-len w) (:overflowchar params))
           (print (apply str (repeat w (:overflowchar params))))
           (print (str
                   (apply str (repeat (- w full-len) (:padchar params)))
-                  (if add-sign "+") 
+                  (if add-sign sign) 
                   (if prepend-zero "0")
                   fixed-repr
                   (if append-zero "0")))))
       (print (str
-              (if add-sign "+") 
+              (if add-sign sign) 
               (if prepend-zero "0")
               fixed-repr
               (if append-zero "0"))))
@@ -761,8 +764,8 @@ Note this should only be used for the last one in the sequence"
         n (:n params) ; minimum digits before the decimal
         w (:w params) ; minimum field width
         add-sign (or (:at params) (neg? arg))
-        [rounded-mantissa scaled-exp _] (round-str mantissa exp d nil)
-        #^String fixed-repr (get-fixed rounded-mantissa scaled-exp d)
+        [rounded-mantissa scaled-exp expanded] (round-str mantissa exp d nil)
+        #^String fixed-repr (get-fixed rounded-mantissa (if expanded (inc scaled-exp) scaled-exp) d)
         full-repr (str (apply str (repeat (- n (.indexOf fixed-repr (int \.))) \0)) fixed-repr)
         full-len (+ (count full-repr) (if add-sign 1 0))]
     (print (str

src/test/clojure/clojure/contrib/pprint/test_cl_format.clj

@@ -194,10 +194,31 @@
   (cl-format nil "~1,1,6$" 0.001) "   0.0"
   (cl-format nil "~1,1,6$" 0.0015) "   0.0"
   (cl-format nil "~2,1,6$" 0.005) "  0.01"
-  (cl-format nil "~2,1,6$" 0.01) "  0.01")
+  (cl-format nil "~2,1,6$" 0.01) "  0.01"
+  (cl-format nil "~$" 0.099) "0.10"
+  (cl-format nil "~1$" 0.099) "0.1"
+  (cl-format nil "~1$" 0.1) "0.1"
+  (cl-format nil "~1$" 0.99) "1.0"
+  (cl-format nil "~1$" -0.99) "-1.0")
 
 (simple-tests f-tests
-  (cl-format nil "~,1f" -12.0) "-12.0")
+  (cl-format nil "~,1f" -12.0) "-12.0"
+  (cl-format nil "~,0f" 9.4) "9."
+  (cl-format nil "~,0f" 9.5) "10."
+  (cl-format nil "~,0f" -0.99) "-1."
+  (cl-format nil "~,1f" -0.99) "-1.0"
+  (cl-format nil "~,2f" -0.99) "-0.99"
+  (cl-format nil "~,3f" -0.99) "-0.990"
+  (cl-format nil "~,0f" 0.99) "1."
+  (cl-format nil "~,1f" 0.99) "1.0"
+  (cl-format nil "~,2f" 0.99) "0.99"
+  (cl-format nil "~,3f" 0.99) "0.990"
+  (cl-format nil "~f" -1) "-1.0"
+  (cl-format nil "~2f" -1) "-1."
+  (cl-format nil "~3f" -1) "-1."
+  (cl-format nil "~4f" -1) "-1.0"
+  (cl-format nil "~8f" -1) "    -1.0"
+  (cl-format nil "~1,1f" 0.1) ".1")
 
 (simple-tests ampersand-tests
   (cl-format nil "The quick brown ~a jumped over ~d lazy dogs" 'elephant 5)