From 912e5671cc8237addf55753ff524bf283830e684 Mon Sep 17 00:00:00 2001 From: Tom Faulhaber Date: Sat, 1 May 2010 00:01:13 -0700 Subject: clojure.contrib.pprint (cl-format): Fixes to rounding and width issues in ~f and ~$. See #47. --- .../clojure/clojure/contrib/pprint/cl_format.clj | 29 ++++++++++++---------- .../clojure/contrib/pprint/test_cl_format.clj | 25 +++++++++++++++++-- 2 files changed, 39 insertions(+), 15 deletions(-) diff --git a/src/main/clojure/clojure/contrib/pprint/cl_format.clj b/src/main/clojure/clojure/contrib/pprint/cl_format.clj index 58080e38..dc332d8c 100644 --- a/src/main/clojure/clojure/contrib/pprint/cl_format.clj +++ b/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,19 +625,21 @@ 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)] @@ -644,12 +647,12 @@ Note this should only be used for the last one in the sequence" (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 diff --git a/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj b/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj index c1c997fd..4022e5e3 100644 --- a/src/test/clojure/clojure/contrib/pprint/test_cl_format.clj +++ b/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) -- cgit v1.2.3-18-g5258