[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 07/07: i18n: Fix corner cases for monetary and number st
From: |
Ludovic Courtès |
Subject: |
[Guile-commits] 07/07: i18n: Fix corner cases for monetary and number string conversions. |
Date: |
Sun, 12 Feb 2017 18:20:50 -0500 (EST) |
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)))))))
- [Guile-commits] branch stable-2.0 updated (f2764cb -> 4aead68), Ludovic Courtès, 2017/02/12
- [Guile-commits] 01/07: doc: Fix typo in keywords documentation., Ludovic Courtès, 2017/02/12
- [Guile-commits] 04/07: i18n: Do not represent zero as "-0"., Ludovic Courtès, 2017/02/12
- [Guile-commits] 03/07: Recognize sh3 as compilation targets, Ludovic Courtès, 2017/02/12
- [Guile-commits] 05/07: tests: Use 'pass-if-equal' for (ice-9 i18n) tests., Ludovic Courtès, 2017/02/12
- [Guile-commits] 02/07: doc: Fix typo in site packages documentation., Ludovic Courtès, 2017/02/12
- [Guile-commits] 06/07: tests: Choose a more plausible US English locale name., Ludovic Courtès, 2017/02/12
- [Guile-commits] 07/07: i18n: Fix corner cases for monetary and number string conversions.,
Ludovic Courtès <=