r34935 - in /trunk/libnumber-format-perl: ./ debian/ t/
ryan52-guest at users.alioth.debian.org
ryan52-guest at users.alioth.debian.org
Fri May 8 06:22:24 UTC 2009
Author: ryan52-guest
Date: Fri May 8 06:22:19 2009
New Revision: 34935
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=34935
Log:
New upstream release
Modified:
trunk/libnumber-format-perl/CHANGES
trunk/libnumber-format-perl/Format.pm
trunk/libnumber-format-perl/META.yml
trunk/libnumber-format-perl/Makefile.PL
trunk/libnumber-format-perl/README
trunk/libnumber-format-perl/debian/changelog
trunk/libnumber-format-perl/debian/watch
trunk/libnumber-format-perl/t/format_bytes.t
trunk/libnumber-format-perl/t/format_negative.t
trunk/libnumber-format-perl/t/format_number.t
trunk/libnumber-format-perl/t/format_picture.t
trunk/libnumber-format-perl/t/format_price.t
trunk/libnumber-format-perl/t/locale.t
trunk/libnumber-format-perl/t/object.t
trunk/libnumber-format-perl/t/round.t
trunk/libnumber-format-perl/t/unformat_number.t
Modified: trunk/libnumber-format-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/CHANGES?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/CHANGES (original)
+++ trunk/libnumber-format-perl/CHANGES Fri May 8 06:22:19 2009
@@ -1,3 +1,31 @@
+Changes for version 1.72 (May 5, 2009)
+------------------------
+ - Use Makefile.PL based on suggestion in RT 38020
+ - Add 'use strict' & 'use warnings'
+ - Add MAX_INT constant for detecting overflows
+ - Add helper sub _get_multipliers for getting kilo/mega/giga mult values
+ - Add test in round() for overflow from large of a precision value (RT 40126)
+ - Add .5 + 1e-14 to rounded value instead of .5000001 (RT 20298)
+ - Fix undef $pic_prefix (RT 43029)
+ - Add support for giga and base option in unformat_number (RT 40455)
+ - Fix Russian locale issues, esp. in unformat_number (RT 40859)
+ - Remove variables from error messages (XSS risk) and standardize errors
+ - Remove requirement that decimal_point & thousands_sep be 1 char (for ru_RU)
+ - Add Russian and unformat_number tests in locale.t
+ - Add compare_numbers to test with an allowable error of 1e-10 in round.t
+
+Changes for version 1.71 (May 3, 2009)
+------------------------
+ - Changes to tests t/format_price.t, t/locale.t, and t/round.t to
+ fix cpan tester errors
+ - No change to Format.pm itself
+
+Changes for version 1.70 (Feb 13, 2009)
+------------------------
+ - Add support for IEC60027 (Ki, Mi, Gi prefixes) with mode option
+ - Use hard coded hex values for base multiplier when base is 1024
+ - Use mon_ settings in format_number when called from format_price
+
Changes for version 1.63 (Feb 10, 2009)
------------------------
- Minor tweak to format_bytes test for German locales
Modified: trunk/libnumber-format-perl/Format.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/Format.pm?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/Format.pm (original)
+++ trunk/libnumber-format-perl/Format.pm Fri May 8 06:22:19 2009
@@ -3,6 +3,9 @@
# Minimum version is 5.8.0. May work on earlier versions, but not
# supported on any version older than 5.8.
require 5.008;
+
+use strict;
+use warnings;
=head1 NAME
@@ -208,7 +211,7 @@
other_vars => \@EXPORT_OTHER,
all => \@EXPORT_ALL );
-our $VERSION = '1.70';
+our $VERSION = '1.72';
# Refer to http://www.opengroup.org/onlinepubs/007908775/xbd/locale.html
# for more details about the POSIX variables
@@ -281,6 +284,16 @@
gibi_suffix => $GIBI_SUFFIX,
) };
+#
+# Largest integer a 32-bit Perl can handle is based on the mantissa
+# size of a double float, which is up to 53 bits. While we may be
+# able to support larger values on 64-bit systems, some Perl integer
+# operations on 64-bit integer systems still use the 53-bit-mantissa
+# double floats. To be safe, we cap at 2**53; use Math::BigFloat
+# instead for larger numbers.
+#
+use constant MAX_INT => 2**53;
+
###---------------------------------------------------------------------
# INTERNAL FUNCTIONS
@@ -318,22 +331,48 @@
croak "Not an object" unless ref $self;
foreach my $prefix ("", "mon_")
{
- croak("Number::Format: {${prefix}thousands_sep} is undefined\n")
+ croak "${prefix}thousands_sep is undefined"
unless defined $self->{"${prefix}thousands_sep"};
- croak("Number::Format: ${prefix}thousands_sep is too long ".
- "(max 1 character)\n")
- if length $self->{"${prefix}thousands_sep"} > 1;
- croak("Number::Format: ${prefix}thousands_sep may not be numeric\n")
+ croak "${prefix}thousands_sep may not be numeric"
if $self->{"${prefix}thousands_sep"} =~ /\d/;
- croak("Number::Format: ${prefix}decimal_point must be ".
- "one character\n")
- if length $self->{"${prefix}decimal_point"} != 1;
- croak("Number::Format: ${prefix}decimal_point may not be numeric\n")
+ croak "${prefix}decimal_point may not be numeric"
if $self->{"${prefix}decimal_point"} =~ /\d/;
- croak("Number::Format: ${prefix}thousands_sep and ".
- "{${prefix}decimal_point may not be equal\n")
+ croak("${prefix}thousands_sep and ".
+ "${prefix}decimal_point may not be equal")
if $self->{"${prefix}decimal_point"} eq
$self->{"${prefix}thousands_sep"};
+ }
+}
+
+##----------------------------------------------------------------------
+
+# _get_multipliers returns the multipliers to be used for kilo, mega,
+# and giga (un-)formatting. Used in format_bytes and unformat_number.
+# For internal use only.
+
+sub _get_multipliers
+{
+ my($base) = @_;
+ if (!defined($base) || $base == 1024)
+ {
+ return ( kilo => 0x00000400,
+ mega => 0x00100000,
+ giga => 0x40000000 );
+ }
+ elsif ($base == 1000)
+ {
+ return ( kilo => 1_000,
+ mega => 1_000_000,
+ giga => 1_000_000_000 );
+ }
+ else
+ {
+ croak "base overflow" if $base **3 > MAX_INT;
+ croak "base must be a positive integer"
+ unless $base > 0 && $base == int($base);
+ return ( kilo => $base,
+ mega => $base ** 2,
+ giga => $base ** 3 );
}
}
@@ -400,7 +439,7 @@
$me->{"${prefix}thousands_sep"});
}
- croak("Invalid args: ".join(',', keys %args)."\n") if %args;
+ croak "Invalid argument(s)" if %args;
bless $me, $type;
$me;
}
@@ -435,10 +474,17 @@
$precision = 2 unless defined $precision;
$number = 0 unless defined $number;
- my $sign = $number <=> 0;
+ my $sign = $number <=> 0;
my $multiplier = (10 ** $precision);
- my $result = abs($number);
- $result = int(($result * $multiplier) + .5000001) / $multiplier;
+ my $result = abs($number);
+ my $product = $result * $multiplier;
+
+ croak "round() overflow. Try smaller precision or use Math::BigFloat"
+ if $product > MAX_INT;
+
+ # We need to add 1e-14 to avoid some rounding errors due to the
+ # way floating point numbers work - see string-eq test in t/round.t
+ $result = int($product + .5 + 1e-14) / $multiplier;
$result = -$result if $sign < 0;
return $result;
}
@@ -559,7 +605,7 @@
{
my($self, $number, $format) = _get_self @_;
$format = $self->{neg_format} unless defined $format;
- croak "Letter x must be present in picture in format_negative()\n"
+ croak "Letter x must be present in picture in format_negative()"
unless $format =~ /x/;
$number =~ s/^-//;
$format =~ s/x/$number/;
@@ -622,9 +668,7 @@
$pic_int = '' unless defined $pic_int;
$pic_dec = '' unless defined $pic_dec;
- croak("Number::Format::format_picture($number, $picture): ".
- "Only one decimal separator($self->{decimal_point}) ".
- "permitted in picture.\n")
+ croak "Only one decimal separator permitted in picture"
if @cruft;
# Obtain precision from the length of the decimal part...
@@ -649,6 +693,7 @@
if (length $num_int > $intsize)
{
$picture =~ s/\#/\*/g; # convert # to * and return it
+ $pic_prefix = "" unless defined $pic_prefix;
$picture =~ s/^(\Q$sign_prefix\E)(\Q$pic_prefix\E)(\s*)/$2$3$1/;
return $picture;
}
@@ -945,7 +990,7 @@
{
my ($self, $number, @options) = _get_self @_;
- croak "Negative number ($number) not allowed in format_bytes\n"
+ croak "Negative number not allowed in format_bytes"
if $number < 0;
# If a single scalar is given instead of key/value pairs for
@@ -992,11 +1037,7 @@
# overflows so it is not supported. Useful values of "base" are
# 1024 or 1000, but any number can be used. Larger numbers may
# cause overflows for giga or even mega, however.
- $options{base} = 1024
- unless defined $options{base};
- my $kilo_th = $options{base} == 1024 ? 0x00000400 : $options{base};
- my $mega_th = $options{base} == 1024 ? 0x00100000 : $options{base} ** 2;
- my $giga_th = $options{base} == 1024 ? 0x40000000 : $options{base} ** 3;
+ my %mult = _get_multipliers($options{base});
# Process "unit" option. Set default, then take first character
# and convert to upper case.
@@ -1008,15 +1049,15 @@
# automatically determine which unit to use.
if ($unit eq 'A')
{
- if ($number >= $giga_th)
+ if ($number >= $mult{giga})
{
$unit = 'G';
}
- elsif ($number >= $mega_th)
+ elsif ($number >= $mult{mega})
{
$unit = 'M';
}
- elsif ($number >= $kilo_th)
+ elsif ($number >= $mult{kilo})
{
$unit = 'K';
}
@@ -1031,22 +1072,22 @@
my $suffix = "";
if ($unit eq 'G')
{
- $number /= $giga_th;
+ $number /= $mult{giga};
$suffix = $gsuff;
}
elsif ($unit eq 'M')
{
- $number /= $mega_th;
+ $number /= $mult{mega};
$suffix = $msuff;
}
elsif ($unit eq 'K')
{
- $number /= $kilo_th;
+ $number /= $mult{kilo};
$suffix = $ksuff;
}
elsif ($unit ne 'N')
{
- croak "format_bytes: Invalid unit option \"$options{unit}\"";
+ croak "Invalid unit option";
}
# Format the number and add the suffix.
@@ -1076,27 +1117,52 @@
``-'' character before any of the digits, then a negative number is
returned.
-If the number ends with the C<KILO_SUFFIX> or C<MEGA_SUFFIX>
-characters, then the number returned will be multiplied by 1024 or
-1024*1024 as appropriate.
+If the number ends with the C<KILO_SUFFIX>, C<KIBI_SUFFIX>,
+C<MEGA_SUFFIX>, C<MEBI_SUFFIX>, C<GIGA_SUFFIX>, or C<GIBI_SUFFIX>
+characters, then the number returned will be multiplied by the
+appropriate multiple of 1024 (or if the base option is given, by the
+multiple of that value) as appropriate. Examples:
+
+ unformat_number("4K", base => 1024) yields 4096
+ unformat_number("4K", base => 1000) yields 4000
+ unformat_number("4KiB", base => 1024) yields 4096
+ unformat_number("4G") yields 4294967296
=cut
sub unformat_number
{
- my ($self, $formatted) = _get_self @_;
+ my ($self, $formatted, %options) = _get_self @_;
$self->_check_seps();
return undef unless $formatted =~ /\d/; # require at least one digit
- # Detect if it ends with the kilo or mega suffix.
- my $kp = ($formatted =~ s/$self->{kilo_suffix}\s*$//);
- my $mp = ($formatted =~ s/$self->{mega_suffix}\s*$//);
+ # Regular expression for detecting decimal point
+ my $pt = qr/\Q$self->{decimal_point}\E/;
+
+ # ru_RU locale has comma for decimal_point, but period for
+ # mon_decimal_point! But as long as thousands_sep is different
+ # from either, we can allow either decimal point.
+ if ($self->{mon_decimal_point} &&
+ $self->{decimal_point} ne $self->{mon_decimal_point} &&
+ $self->{decimal_point} ne $self->{mon_thousands_sep} &&
+ $self->{mon_decimal_point} ne $self->{thousands_sep})
+ {
+ $pt = qr/(?:\Q$self->{decimal_point}\E|
+ \Q$self->{mon_decimal_point}\E)/x;
+ }
+
+ # Detect if it ends with one of the kilo / mega / giga suffixes.
+ my $kp = ($formatted =~
+ s/\s*($self->{kilo_suffix}|$self->{kibi_suffix})\s*$//);
+ my $mp = ($formatted =~
+ s/\s*($self->{mega_suffix}|$self->{mebi_suffix})\s*$//);
+ my $gp = ($formatted =~
+ s/\s*($self->{giga_suffix}|$self->{gibi_suffix})\s*$//);
+ my %mult = _get_multipliers($options{base});
# Split number into integer and decimal parts
- my ($integer, $decimal, @cruft) =
- split(/\Q$self->{decimal_point}\E/, $formatted);
- croak("Number::Format::unformat_number($formatted): ".
- "Only one decimal separator($self->{decimal_point}) permitted.\n")
+ my ($integer, $decimal, @cruft) = split($pt, $formatted);
+ croak "Only one decimal separator permitted"
if @cruft;
# It's negative if the first non-digit character is a -
@@ -1115,8 +1181,9 @@
$number = -$number if $sign < 0;
# Scale the number if it ended in kilo or mega suffix.
- $number *= 1024 if $kp;
- $number *= 1048576 if $mp;
+ $number *= $mult{kilo} if $kp;
+ $number *= $mult{mega} if $mp;
+ $number *= $mult{giga} if $gp;
return $number;
}
Modified: trunk/libnumber-format-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/META.yml?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/META.yml (original)
+++ trunk/libnumber-format-perl/META.yml Fri May 8 06:22:19 2009
@@ -1,12 +1,16 @@
--- #YAML:1.0
name: Number-Format
-version: 1.70
-abstract: ~
+version: 1.72
+abstract: Perl extension for formatting numbers
license: perl
-author: ~
+author:
+ - William R. Ward <wrw at cpan.org>
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
+ Carp: 0
+ POSIX: 0
+ Test::More: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
Modified: trunk/libnumber-format-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/Makefile.PL?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/Makefile.PL (original)
+++ trunk/libnumber-format-perl/Makefile.PL Fri May 8 06:22:19 2009
@@ -1,8 +1,17 @@
+use 5.008;
+use strict;
+use warnings;
use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
-WriteMakefile(
- 'LICENSE'=> 'perl',
- 'NAME' => 'Number::Format',
- 'VERSION_FROM' => 'Format.pm', # finds $VERSION
- );
+
+WriteMakefile
+ ( NAME => 'Number::Format',
+ VERSION_FROM => 'Format.pm', # finds $VERSION
+ PREREQ_PM => { 'Test::More' => 0,
+ 'Carp' => 0,
+ 'POSIX' => 0 },
+
+ ($ExtUtils::MakeMaker::VERSION ge '6.31'? (LICENSE => 'perl', ) : ()),
+
+ AUTHOR => 'William R. Ward <wrw@'.'cpan.org>',
+ ABSTRACT => 'Perl extension for formatting numbers',
+ );
Modified: trunk/libnumber-format-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/README?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/README (original)
+++ trunk/libnumber-format-perl/README Fri May 8 06:22:19 2009
@@ -1,6 +1,5 @@
Number::Format - Convert numbers to strings with pretty formatting
-Version: 1.62
WHAT IS IT
@@ -75,6 +74,7 @@
Please check for existing bug reports on your issue in both places
before filing a new bug.
+
MAILING LIST
We have an electronic mailing list for announcements of new releases
@@ -100,28 +100,8 @@
information.
-RECENT CHANGES
+CHANGES
-Changes for version 1.63 (Feb 10, 2009)
-------------------------
- - Minor tweak to format_bytes test for German locales
-
-Changes for version 1.62 (Feb 9, 2009)
-------------------------
- - Change format_bytes to fully specify all formatting options, not
- rely on locale at all as it was causing too many CPAN tester errors.
-
-Changes for version 1.61 (Dec 29, 2008)
-------------------------
- - Fix bugs in locale operations for format_price (thanks Moritz Onken)
- - Fix documentation in format_bytes (rt # 42036)
- - Enable warning when format_bytes called with numeric precision not hash
-
-Changes for version 1.60 (Jul 2, 2008)
-------------------------
- - Rewrite new() and format_price() to use mon_* POSIX Locale values
- - Add all missing POSIX Locale variables
- (Thanks to Kevin Ryde for help identifying the problem)
-
-See the file "CHANGES" for more details and previous changes. You
-can also browse the CVS history on SourceForge for full details.
+See the file "CHANGES" for a description of the changes with each
+version of Number::Format. You can also browse the CVS history on
+SourceForge for full details.
Modified: trunk/libnumber-format-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/debian/changelog?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/debian/changelog (original)
+++ trunk/libnumber-format-perl/debian/changelog Fri May 8 06:22:19 2009
@@ -1,3 +1,9 @@
+libnumber-format-perl (1.72a-1) UNRELEASED; urgency=low
+
+ * New upstream release
+
+ -- Ryan Niebur <ryanryan52 at gmail.com> Thu, 07 May 2009 23:22:08 -0700
+
libnumber-format-perl (1.70-1) unstable; urgency=low
* Take over for the Debian Perl Group on maintainer's request
Modified: trunk/libnumber-format-perl/debian/watch
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/debian/watch?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/debian/watch (original)
+++ trunk/libnumber-format-perl/debian/watch Fri May 8 06:22:19 2009
@@ -1,2 +1,2 @@
version=3
-http://search.cpan.org/dist/Number-Format/ .+/Number-Format-v?(\d[\d_.-]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$
+http://search.cpan.org/dist/Number-Format/ .+/Number-Format-v?(\d[\d_.-a-z]+)\.(?:tar(?:\.gz|\.bz2)?|tgz|zip)$
Modified: trunk/libnumber-format-perl/t/format_bytes.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/format_bytes.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/format_bytes.t (original)
+++ trunk/libnumber-format-perl/t/format_bytes.t Fri May 8 06:22:19 2009
@@ -1,6 +1,8 @@
# -*- CPerl -*-
-use Test::More tests => 18;
+use Test::More qw(no_plan);
+use strict;
+use warnings;
BEGIN { use_ok('Number::Format', ':subs') }
Modified: trunk/libnumber-format-perl/t/format_negative.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/format_negative.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/format_negative.t (original)
+++ trunk/libnumber-format-perl/t/format_negative.t Fri May 8 06:22:19 2009
@@ -1,6 +1,9 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
Modified: trunk/libnumber-format-perl/t/format_number.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/format_number.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/format_number.t (original)
+++ trunk/libnumber-format-perl/t/format_number.t Fri May 8 06:22:19 2009
@@ -1,6 +1,9 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
@@ -14,3 +17,13 @@
is(format_number('1.2300', 7, 1), '1.2300000', 'extra zeroes');
is(format_number(.23, 7, 1), '0.2300000', 'leading zero');
is(format_number(-100, 7, 1), '-100.0000000', 'negative with zeros');
+
+#
+# https://rt.cpan.org/Ticket/Display.html?id=40126
+# The test should fail because 20 digits is too big to correctly store
+# in a scalar variable without using Math::BigFloat.
+#
+eval { format_number(97, 20) };
+like($@,
+ qr/^\Qround() overflow. Try smaller precision or use Math::BigFloat/,
+ "round overflow");
Modified: trunk/libnumber-format-perl/t/format_picture.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/format_picture.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/format_picture.t (original)
+++ trunk/libnumber-format-perl/t/format_picture.t Fri May 8 06:22:19 2009
@@ -1,12 +1,15 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
BEGIN { use_ok('Number::Format') }
-$pic = 'US$##,###,###.##';
+my $pic = 'US$##,###,###.##';
my $x = Number::Format->new;
$x->{neg_format} = '-x';
is($x->format_picture(123456.512, $pic), 'US$ 123,456.51', 'thou');
Modified: trunk/libnumber-format-perl/t/format_price.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/format_price.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/format_price.t (original)
+++ trunk/libnumber-format-perl/t/format_price.t Fri May 8 06:22:19 2009
@@ -1,6 +1,9 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
@@ -12,12 +15,10 @@
-decimal_point => '.',
-frac_digits => 2,
-int_frac_digits => 2,
- -n_cs_precedes => 0,
-n_cs_precedes => 1,
-n_sep_by_space => 1,
-n_sign_posn => 1,
-negative_sign => '-',
- -p_cs_precedes => 0,
-p_cs_precedes => 1,
-p_sep_by_space => 1,
-p_sign_posn => 1,
@@ -120,11 +121,11 @@
'sep=2 posn=4 prec=1' => 'USD -9.9500'
);
-foreach $sep (0..2)
+foreach my $sep (0..2)
{
- foreach $posn (0..4)
+ foreach my $posn (0..4)
{
- foreach $prec (0..1)
+ foreach my $prec (0..1)
{
my $key = "sep=$sep posn=$posn prec=$prec";
my $want = $results{$key};
@@ -143,12 +144,24 @@
12578.5 => "EUR 12.578,50" );
my $nf = Number::Format->new(
- mon_thousands_sep => q{.},
- mon_decimal_point => q{,},
- int_curr_symbol => q{EUR},
- p_sep_by_space => 1,
- decimal_digits => 2,
- decimal_fill => 1,
+ -int_curr_symbol => 'EUR',
+ -currency_symbol => '$',
+ -decimal_point => ',',
+ -frac_digits => 2,
+ -int_frac_digits => 2,
+ -n_cs_precedes => 1,
+ -n_sep_by_space => 1,
+ -n_sign_posn => 1,
+ -negative_sign => '-',
+ -p_cs_precedes => 1,
+ -p_sep_by_space => 1,
+ -p_sign_posn => 1,
+ -positive_sign => '',
+ -thousands_sep => '.',
+ -mon_thousands_sep => '.',
+ -decimal_fill => 1,
+ -decimal_digits => 2,
+ -mon_decimal_point => ',',
);
for my $price ( sort keys %prices )
Modified: trunk/libnumber-format-perl/t/locale.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/locale.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/locale.t (original)
+++ trunk/libnumber-format-perl/t/locale.t Fri May 8 06:22:19 2009
@@ -1,6 +1,8 @@
# -*- CPerl -*-
-use Test::More tests => 5;
+use Test::More qw(no_plan);
+use strict;
+use warnings;
BEGIN { use_ok('Number::Format') }
BEGIN { use_ok('POSIX') }
@@ -18,16 +20,35 @@
$german->{n_cs_precedes} = $german->{p_cs_precedes} = '0';
$german->{n_sep_by_space} = $german->{p_sep_by_space} = '1';
$german->{thousands_sep} = '.';
+ $german->{decimal_point} = ',';
- foreach my $key (sort keys %should)
- {
- next if $locale_values->{$key} eq $should{$key};
- warn "$key: '$locale_values->{$key}' != '$should{$key}'\n";
- }
+ my $curr = $german->{int_curr_symbol}; # may be EUR or DEM
+ my $num = "123.456,79";
- my $curr = $german->{int_curr_symbol}; # may be EUR or DEM
- is($german->format_price(123456.789), "123.456,79 $curr", "German money");
+ is($german->format_price(123456.789), "$num $curr", "euros");
+ is($german->unformat_number($num), 123456.79, "unformat German");
}
+
+SKIP:
+{
+ setlocale(&LC_ALL, 'ru_RU')
+ or setlocale(&LC_ALL, 'ru_RU.utf8')
+ or setlocale(&LC_ALL, 'ru_RU.ISO8859-5')
+ or skip("Unable to set ru_RU locale", 1);
+ my $russian = Number::Format->new();
+
+ my $sep = $russian->{mon_thousands_sep};
+ my $dec = $russian->{mon_decimal_point};
+ my $num = "123${sep}456${dec}79";
+
+ is($russian->format_price(123456.789), "$num RUB ", "rubles");
+ is($russian->unformat_number("$num RUB "), 123456.79, "unformat rubles");
+ is($russian->unformat_number($num), 123456.79, "unformat Russian 1");
+ $num = "123${sep}456$russian->{decimal_point}79";
+ is($russian->unformat_number($num), 123456.79, "unformat Russian 2");
+}
+
+my $num = "123,456.79";
SKIP:
{
@@ -36,11 +57,14 @@
or setlocale(&LC_ALL, 'en_US.ISO8859-1')
or skip("Unable to set en_US locale", 1);
my $english = Number::Format->new();
- is($english->format_price(123456.789), 'USD 123,456.79', 'USD');
+
+ is($english->format_price(123456.789), "USD $num", "USD");
+ is($english->unformat_number($num), 123456.79, "unformat English");
}
-setlocale(&LC_ALL, 'C')
+setlocale(&LC_ALL, "C")
or skip("Unable to set en_US locale", 1);
my $c = Number::Format->new();
is($c->format_price(123456.789, 2, "currency_symbol"),
- '$ 123,456.79', 'Dollar sign');
+ "\$ $num", "Dollar sign");
+is($c->unformat_number($num), 123456.79, "unformat C");
Modified: trunk/libnumber-format-perl/t/object.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/object.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/object.t (original)
+++ trunk/libnumber-format-perl/t/object.t Fri May 8 06:22:19 2009
@@ -1,6 +1,9 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
Modified: trunk/libnumber-format-perl/t/round.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/round.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/round.t (original)
+++ trunk/libnumber-format-perl/t/round.t Fri May 8 06:22:19 2009
@@ -1,6 +1,9 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
@@ -8,18 +11,29 @@
use constant PI => 4*atan2(1,1);
-cmp_ok(round(0), '==', 0, 'identity');
-cmp_ok(round(1), '==', 1, 'identity');
-cmp_ok(round(-1), '==', -1, 'identity');
-cmp_ok(round(PI,2), '==', 3.14, 'pi with precision=2');
-cmp_ok(round(PI,3), '==', 3.142, 'pi with precision=3');
-cmp_ok(round(PI,4), '==', 3.1416, 'pi with precision=4');
-cmp_ok(round(PI,5), '==', 3.14159, 'pi with precision=5');
-cmp_ok(round(PI,6), '==', 3.141593, 'pi with precision=6');
-cmp_ok(round(PI,7), '==', 3.1415927, 'pi with precision=7');
-cmp_ok(round(123456.512), '==', 123456.51, 'precision=0' );
-cmp_ok(round(-1234567.509, 2), '==', -1234567.51, 'negative thousandths' );
-cmp_ok(round(-12345678.5, 2), '==', -12345678.5, 'negative tenths' );
-cmp_ok(round(-123456.78951, 4), '==', -123456.7895, 'precision=4' );
-cmp_ok(round(123456.78951, -2), '==', 123500, 'precision=-2' );
-is( round(1.005, 2), 1.01, 'string-eq' );
+ok(compare_numbers(round(0), 0), 'identity 0');
+ok(compare_numbers(round(1), 1), 'identity 1');
+ok(compare_numbers(round(-1), -1), 'identity -1');
+ok(compare_numbers(round(PI,2), 3.14), 'pi prec=2');
+ok(compare_numbers(round(PI,3), 3.142), 'pi prec=3');
+ok(compare_numbers(round(PI,4), 3.1416), 'pi prec=4');
+ok(compare_numbers(round(PI,5), 3.14159), 'pi prec=5');
+ok(compare_numbers(round(PI,6), 3.141593), 'pi prec=6');
+ok(compare_numbers(round(PI,7), 3.1415927), 'pi prec=7');
+ok(compare_numbers(round(123456.512), 123456.51), 'precision=0' );
+ok(compare_numbers(round(-1234567.509, 2), -1234567.51), 'negative thous' );
+ok(compare_numbers(round(-12345678.5, 2), -12345678.5), 'negative tenths' );
+ok(compare_numbers(round(-123456.78951, 4), -123456.7895), 'precision=4' );
+ok(compare_numbers(round(123456.78951, -2), 123500), 'precision=-2' );
+
+# Without the 1e-10 "epsilon" value in round(), the floating point
+# number math will result in 1 rather than 1.01 for this test.
+is(round(1.005, 2), 1.01, 'string-eq' );
+
+# Compare numbers within an epsilon value to avoid false negative
+# results due to floating point math
+sub compare_numbers
+{
+ my($p, $q) = @_;
+ return abs($p - $q) < 1e-10;
+}
Modified: trunk/libnumber-format-perl/t/unformat_number.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libnumber-format-perl/t/unformat_number.t?rev=34935&op=diff
==============================================================================
--- trunk/libnumber-format-perl/t/unformat_number.t (original)
+++ trunk/libnumber-format-perl/t/unformat_number.t Fri May 8 06:22:19 2009
@@ -1,6 +1,9 @@
# -*- CPerl -*-
use Test::More qw(no_plan);
+use strict;
+use warnings;
+
use POSIX;
setlocale(&LC_ALL, 'en_US');
@@ -20,3 +23,25 @@
$x->{neg_format} = '(x)';
cmp_ok($x->unformat_number('(123,456,789.51)'),
'==', -123456789.51,'neg paren');
+
+cmp_ok(unformat_number('(123,456,789.51)'),
+ '==', 123456789.51,'neg default');
+
+cmp_ok(unformat_number("4K", base => 1024), '==', 4096, '4x1024');
+cmp_ok(unformat_number("4K", base => 1000), '==', 4000, '4x1000');
+cmp_ok(unformat_number("4KiB", base => 1024), '==', 4096, '4x1024 KiB');
+cmp_ok(unformat_number("4KiB", base => 1000), '==', 4000, '4x1000 KiB');
+cmp_ok(unformat_number("4G"), '==', 4294967296, '4G');
+cmp_ok(unformat_number("4G", base => 1), '==', 4, 'base 1');
+
+eval { unformat_number("4G", base => 1000000) };
+like($@, qr/^\Qbase overflow/, "base overflow");
+
+eval { unformat_number("4G", base => 0) };
+like($@, qr/^\Qbase must be a positive integer/, "base 0");
+
+eval { unformat_number("4G", base => .5) };
+like($@, qr/^\Qbase must be a positive integer/, "base .5");
+
+eval { unformat_number("4G", base => -1) };
+like($@, qr/^\Qbase must be a positive integer/, "base neg");
More information about the Pkg-perl-cvs-commits
mailing list