The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl

use 5.010;
use strict;
use warnings;
use Parse::Number::EN qw($Pat parse_number_en);
use Test::More 0.96;

sub test_parse {
    my (%args) = @_;
    my $name = $args{name} // $args{num};

    subtest $name => sub {
        my $res;
        my $eval_err;
        eval { $res = parse_number_en(%{$args{args}}) }; $eval_err = $@;

        if ($args{dies}) {
            ok($eval_err, "dies");
        } else {
            ok(!$eval_err, "doesn't die") or diag $eval_err;
        }

        if (exists $args{res}) {
            is($res, $args{res}, "result");
        }
    };
}

test_parse name => 'empty string', args=>{text => ''}, res => undef;
test_parse name => 'no digits', args=>{text => 'x'}, res => undef;
test_parse name => 'int', args=>{text => '123'}, res => 123;
test_parse name => 'int (2)', args=>{text => '-123'}, res => -123;
test_parse name => 'int (3)', args=>{text => '+123'}, res => 123;
test_parse name => 'double sign = err (1)', args=>{text=>'--123'}, res => undef;
test_parse name => 'double sign = err (2)', args=>{text=>'++123'}, res => undef;
test_parse name => 'whitespace', args=>{text => ' 123 '}, res => 123;
test_parse name => 'nondigit', args=>{text => 'x123'}, res => undef;
test_parse name => 'nondigit 2', args=>{text => '1, 2, 3'}, res => 1;
test_parse name => 'nondigit 2b', args=>{text => '1x23'}, res => 1;
test_parse name => 'decimal (id 1)', args=>{text => '12,3'}, res => 12;
test_parse name => 'decimal (id 2)', args=>{text => ',3'}, res => undef;
test_parse name => 'decimal (id 3)', args=>{text => '-12,3'}, res => -12;
test_parse name => 'decimal (en 1)', args=>{text => '12.31'}, res => 12.31;
test_parse name => 'decimal (en 2)', args=>{text => '.31'}, res => 0.31;
test_parse name => 'decimal (en 3)', args=>{text => '-12.31'}, res => -12.31;
test_parse name=>'thousand sep 1 (en)', args=>{text=>'123,001'}, res => 123001;
test_parse name=>'thousand sep 2 (e)', args=>{text=>'12,300,000'}, res => 12300000;

test_parse name=>'decimal+thousand sep 1',
    args=>{text=>'-12.300,01'}, res => -12.3;
test_parse name=>'decimal+thousand sep 2',
    args=>{text=>'12.300.01'}, res => 12.3;
test_parse name=>'decimal+thousand sep 3',
    args=>{text=>'12,300.01'}, res => 12300.01;
test_parse name=>'decimal+thousand sep 4',
    args=>{text=>'12,300,01'}, res => 12300;

test_parse name=>'exponent 1', args=>{text=>'1e5'}, res => 1e5;
test_parse name=>'exponent 2', args=>{text=>'-1e5'}, res => -1e5;
test_parse name=>'exponent 3', args=>{text=>'1e-5'}, res => 1e-5;
test_parse name=>'exponent 4', args=>{text=>'-1e-5'}, res => -1e-5;
test_parse name=>'exponent 5', args=>{text=>'1,1e2'}, res => 1;
test_parse name=>'exponent 6', args=>{text=>'1.1e2'}, res => 1.1e2;
test_parse name=>'exponent 6', args=>{text=>'.12e2'}, res => 12;

my %test_pat = (
    "1" => 1,
    "1.23" => 1,
    "+1.23" => 1,
    "1,23" => 0,
    "-1,23" => 0,
    "9e-1" => 1,
    "9.1e+2" => 1,
    "9,13e3" => 0,
    "9,000,000" => 1,
    "9.000.000" => 0,
    "9,000.3" => 1,
    "90.000,4" => 0,

    "abc" => 0,
    "1abc" => 0,
    "abc2" => 0,
    "e" => 0,
    "e3" => 0,
    "++1" => 0,
    "9,000,4" => 0,
    "9.000.5" => 0,
    "9,000,0000" => 0,
    "9.000.0000" => 0,
);

for (sort keys %test_pat) {
    my $match = $_ =~ /\A$Pat\z/;
    if ($test_pat{$_}) {
        ok($match, "'$_' matches");
    } else {
        ok(!$match, "'$_' doesn't match");
    }
}

DONE_TESTING:
done_testing();