mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
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.
This commit is contained in:
Ludovic Courtès
parent
21602109f0
commit
4aead68cdb
3 changed files with 88 additions and 30 deletions
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
||||
;;;
|
||||
;;; ~{
|
||||
|
|
|
|||
|
|
@ -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)))))))
|
||||
(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 .00003 #t fr)))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue