Permalink
Browse files

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

…s in ~f and ~$. See #47.
  • Loading branch information...
1 parent 661dcfd commit 912e5671cc8237addf55753ff524bf283830e684 @tomfaulhaber tomfaulhaber committed May 1, 2010
@@ -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
@@ -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)

0 comments on commit 912e567

Please sign in to comment.