[Guile-commits] 07/07: i18n: Fix corner cases for monetary and number string conversions.

[Ludovic Courtès]

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 4aead68cdb86ca60cc372f0cd558cadda90ddec5
Author: Ludovic Courtès <address@hidden>
Date:   Mon Feb 13 00:07:40 2017 +0100

    i18n: Fix corner cases for monetary and number string conversions.
    
    Fixes <http://bugs.gnu.org/24990>.
    Reported by Martin Michel <address@hidden>.
    
    * module/ice-9/i18n.scm (integer->string, number-decimal-string): New
    procedures.
    (monetary-amount->locale-string): Use them instead of 'number->string'
    followed by 'string-split'.
    (number->locale-string): Likewise.
    * test-suite/tests/i18n.test ("number->locale-string")["fraction"]: Add
    second argument to 'number->locale-string'.
    ["fraction, 1 digit"]: Round up.
    ["fraction, 10 digits", "trailing zeros", "negative integer"]: New
    tests.
    * test-suite/tests/i18n.test ("format ~h"): Pass the number of decimals
    for ~h.
    ("monetary-amount->locale-string")["French"]: Always expect two decimals
    after the comma.
    ["one cent", "very little money"]: New tests.
    * test-suite/tests/format.test ("~h localized number")["1234.5"]:
    Specify the number of decimals explicitly.
    ["padding"]: Expect zero decimals.
    ["padchar"]: Ask for one decimal.
    ["decimals", "locale"]: Adjust rounding.
---
 module/ice-9/i18n.scm        | 57 +++++++++++++++++++++++++++++++++-----------
 test-suite/tests/format.test | 12 +++++-----
 test-suite/tests/i18n.test   | 49 +++++++++++++++++++++++++++++--------
 3 files changed, 88 insertions(+), 30 deletions(-)

diff --git a/module/ice-9/i18n.scm b/module/ice-9/i18n.scm
index 1326a2a..2363ba3 100644
--- a/module/ice-9/i18n.scm
+++ b/module/ice-9/i18n.scm
@@ -246,6 +246,36 @@
   'unspecified        'unspecified)
 
 
+(define (integer->string number)
+  "Return a string representing NUMBER, an integer, written in base 10."
+  (define (digit->char digit)
+    (integer->char (+ digit (char->integer #\0))))
+
+  (if (zero? number)
+      "0"
+      (let loop ((number number)
+                 (digits '()))
+        (if (zero? number)
+            (list->string digits)
+            (loop (quotient number 10)
+                  (cons (digit->char (modulo number 10))
+                        digits))))))
+
+(define (number-decimal-string number digit-count)
+  "Return a string representing the decimal part of NUMBER, with exactly
+DIGIT-COUNT digits"
+  (if (integer? number)
+      (make-string digit-count #\0)
+
+      ;; XXX: This is brute-force and could be improved by following one
+      ;; of the "Printing Floating-Point Numbers Quickly and Accurately"
+      ;; papers.
+      (let ((number (* (expt 10 digit-count)
+                       (- number (floor number)))))
+        (string-pad (integer->string (round (inexact->exact number)))
+                    digit-count
+                    #\0))))
+
 (define (%number-integer-part int grouping separator)
   ;; Process INT (a string denoting a number's integer part) and return a new
   ;; string with digit grouping and separators according to GROUPING (a list,
@@ -336,12 +366,11 @@ locale is used."
                                    (substring dec 0 fraction-digits)
                                    dec)))))
 
-         (external-repr (number->string (if (>= amount 0) amount (- amount))))
-         (int+dec   (string-split external-repr #\.))
-         (int       (car int+dec))
-         (dec       (decimal-part (if (null? (cdr int+dec))
-                                      ""
-                                      (cadr int+dec))))
+         (int       (integer->string (inexact->exact
+                                      (floor (abs amount)))))
+         (dec       (decimal-part
+                     (number-decimal-string (abs amount)
+                                            fraction-digits)))
          (grouping  (locale-monetary-digit-grouping locale))
          (separator (locale-monetary-thousands-separator locale)))
 
@@ -388,14 +417,14 @@ number of fractional digits to be displayed."
                                    (substring dec 0 fraction-digits)
                                    dec))))))
 
-    (let* ((external-repr (number->string (if (>= number 0)
-                                              number
-                                              (- number))))
-           (int+dec   (string-split external-repr #\.))
-           (int       (car int+dec))
-           (dec       (decimal-part (if (null? (cdr int+dec))
-                                        ""
-                                        (cadr int+dec))))
+    (let* ((int       (integer->string (inexact->exact
+                                        (floor (abs number)))))
+           (dec       (decimal-part
+                       (number-decimal-string (abs number)
+                                              (if (integer?
+                                                   fraction-digits)
+                                                  fraction-digits
+                                                  0))))
            (grouping  (locale-digit-grouping locale))
            (separator (locale-thousands-separator locale)))
 
diff --git a/test-suite/tests/format.test b/test-suite/tests/format.test
index cc31942..9acbbcc 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -2,7 +2,7 @@
 ;;;; Matthias Koeppe <address@hidden> --- June 2001
 ;;;;
 ;;;; Copyright (C) 2001, 2003, 2004, 2006, 2010, 2011, 2012,
-;;;;   2014 Free Software Foundation, Inc.
+;;;;   2014, 2017 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -124,22 +124,22 @@
 (with-test-prefix "~h localized number"
 
   (pass-if "1234.5"
-    (string=? (format #f "~h" 1234.5) "1234.5"))
+    (string=? (format #f "~,1h" 1234.5) "1234.5"))
 
   (pass-if "padding"
-    (string=? (format #f "~6h" 123.2) " 123.2"))
+    (string=? (format #f "~6h" 123.2) "   123"))
 
   (pass-if "padchar"
-    (string=? (format #f "~8,,'*h" 123.2) "***123.2"))
+    (string=? (format #f "~8,1,'*h" 123.2) "***123.2"))
 
   (pass-if "decimals"
     (string=? (format #f "~,2h" 123.4567)
-              "123.45"))
+              "123.46"))
 
   (pass-if "locale"
     (string=? (format #f "~,3:h, ~a" 1234.5678
                       %global-locale "approximately")
-              "1234.567, approximately")))
+              "1234.568, approximately")))
 
 ;;;
 ;;; ~{
diff --git a/test-suite/tests/i18n.test b/test-suite/tests/i18n.test
index 3ce2b15..db7fa65 100644
--- a/test-suite/tests/i18n.test
+++ b/test-suite/tests/i18n.test
@@ -506,12 +506,20 @@
 
     (pass-if-equal "fraction"
         "1234.567"
-      (number->locale-string 1234.567))
+      (number->locale-string 1234.567 3))
 
     (pass-if-equal "fraction, 1 digit"
-        "1234.5"
+        "1234.6"
       (number->locale-string 1234.567 1))
 
+    (pass-if-equal "fraction, 10 digits"
+        "0.0000300000"
+      (number->locale-string .00003 10))
+
+    (pass-if-equal "trailing zeros"
+        "-10.00000"
+      (number->locale-string -10.0 5))
+
     (pass-if-equal "positive inexact zero, 1 digit"
         "0.0"
       (number->locale-string .0 1)))
@@ -525,15 +533,22 @@
          (let ((fr (make-locale LC_ALL %french-locale-name)))
            (number->locale-string 123456 #t fr)))))
 
+    (pass-if-equal "negative integer"
+        "-1 234 567"
+      (under-french-locale-or-unresolved
+       (lambda ()
+         (let ((fr (make-locale LC_ALL %french-locale-name)))
+           (number->locale-string -1234567 #t fr)))))
+
     (pass-if-equal "fraction"
         "1 234,567"
       (under-french-locale-or-unresolved
        (lambda ()
          (let ((fr (make-locale LC_ALL %french-locale-name)))
-           (number->locale-string 1234.567 #t fr)))))
+           (number->locale-string 1234.567 3 fr)))))
 
     (pass-if-equal "fraction, 1 digit"
-        "1 234,5"
+        "1 234,6"
       (under-french-locale-or-unresolved
        (lambda ()
          (let ((fr (make-locale LC_ALL %french-locale-name)))
@@ -553,7 +568,7 @@
        (lambda ()
          (if (null? (locale-digit-grouping %french-locale))
              (throw 'unresolved)
-             (format #f "~:h" 12345.6789 %french-locale))))))
+             (format #f "~,4:h" 12345.6789 %french-locale))))))
 
   (with-test-prefix "English"
 
@@ -563,7 +578,7 @@
        (lambda ()
          (if (null? (locale-digit-grouping %american-english-locale))
              (throw 'unresolved)
-             (format #f "~:h" 12345.6789
+             (format #f "~,4:h" 12345.6789
                      %american-english-locale)))))))
 
 (with-test-prefix "monetary-amount->locale-string"
@@ -571,22 +586,36 @@
   (with-test-prefix "French"
 
     (pass-if-equal "integer"
-        "123 456 +EUR"
+        "123 456,00 +EUR"
       (under-french-locale-or-unresolved
        (lambda ()
          (let ((fr (make-locale LC_ALL %french-locale-name)))
            (monetary-amount->locale-string 123456 #f fr)))))
 
     (pass-if-equal "fraction"
-        "1 234,56 EUR "
+        "1 234,57 EUR "
       (under-french-locale-or-unresolved
        (lambda ()
          (let ((fr (make-locale LC_ALL %french-locale-name)))
            (monetary-amount->locale-string 1234.567 #t fr)))))
 
     (pass-if-equal "positive inexact zero"
-        "0,0 +EUR"
+        "0,00 +EUR"
+      (under-french-locale-or-unresolved
+       (lambda ()
+         (let ((fr (make-locale LC_ALL %french-locale-name)))
+           (monetary-amount->locale-string 0. #f fr)))))
+
+    (pass-if-equal "one cent"
+        "0,01 EUR "
+      (under-french-locale-or-unresolved
+       (lambda ()
+         (let ((fr (make-locale LC_ALL %french-locale-name)))
+           (monetary-amount->locale-string .01 #t fr)))))
+
+    (pass-if-equal "very little money"
+        "0,00 EUR "
       (under-french-locale-or-unresolved
        (lambda ()
          (let ((fr (make-locale LC_ALL %french-locale-name)))
-           (monetary-amount->locale-string 0. #f fr)))))))
+           (monetary-amount->locale-string .00003 #t fr)))))))