summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-02-13 00:07:40 +0100
committerLudovic Courtès <ludo@gnu.org>2017-02-13 00:18:09 +0100
commit4aead68cdb86ca60cc372f0cd558cadda90ddec5 (patch)
treee545dff99ebd37d8780d76a53cb4785987a7d7e5
parent21602109f03321919bbce3c9d7fe8ce1b006ebb9 (diff)
downloadguile-4aead68cdb86ca60cc372f0cd558cadda90ddec5.tar.gz
i18n: Fix corner cases for monetary and number string conversions.
Fixes <http://bugs.gnu.org/24990>. Reported by Martin Michel <dev@famic.de>. * 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.
-rw-r--r--module/ice-9/i18n.scm57
-rw-r--r--test-suite/tests/format.test12
-rw-r--r--test-suite/tests/i18n.test49
3 files changed, 88 insertions, 30 deletions
diff --git a/module/ice-9/i18n.scm b/module/ice-9/i18n.scm
index 1326a2a02..2363ba350 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 cc31942cc..9acbbcc22 100644
--- a/test-suite/tests/format.test
+++ b/test-suite/tests/format.test
@@ -2,7 +2,7 @@
;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- 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 3ce2b15cb..db7fa65e2 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)))))))