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

use strict;
use lib  qw {blib/lib};

use Regexp::Common qw /RE_num_decimal/;
use t::Common;

my $decimal = $RE {num} {decimal};

# The following arrays contain valid numbers in the respective bases -
# and the numbers aren't valid in the next array.
my @data = (
    [36  => [qw /regexp common perl5/]],
    [16  => [qw /deadbeaf c0c0a c1a0 55b/]],
    [10  => [qw /81320981536123490812346123 129 9/]],
    [ 8  => [qw /777 153/]],
    [ 2  => [qw /0 1 1010101110/]],
);

my (%targets, @tests);

foreach my $entry (@data) {
    my ($base, $list) = @$entry;

    $targets {"${base}_int"} = {
        list   => $list,
        query  => sub {$_ [0]},
        wanted => sub {$_ [0], "", $_ [0], $_ [0], undef, undef}
    };

    for my $exp ([dot => "."], [comma => ","]) {
        my ($name, $punct) = @$exp;
        $targets {"${base}_int_${name}"} = {
            list   => $list,
            query  => sub {$_ [0] . $punct},
            wanted => sub {$_ [0] . $punct, "",
                           $_ [0] . $punct, $_ [0], $punct, ""}
        };

        $targets {"${base}_${name}_frac"} = {
            list   => $list,
            query  => sub {$_ [0] . $punct},
            wanted => sub {$_ [0] . $punct, "",
                           $_ [0] . $punct, $_ [0], $punct, ""}
        };

        $targets {"${base}_minus_${name}_frac"} = {
            list   => $list,
            query  => sub {"-" . $_ [0] . $punct},
            wanted => sub {"-" . $_ [0] . $punct, "-",
                                 $_ [0] . $punct, $_ [0], $punct, ""}
        };

        $targets {"${base}_plus_${name}_frac"} = {
            list   => $list,
            query  => sub {"+" . $_ [0] . $punct},
            wanted => sub {"+" . $_ [0] . $punct, "+",
                                 $_ [0] . $punct, $_ [0], $punct, ""}
        };
    }

    $targets {"${base}_minus_int"} = {
        list   => $list,
        query  => sub {"-" . $_ [0]},
        wanted => sub {"-" . $_ [0], "-", $_ [0], $_ [0], "", ""}
    };

    $targets {"${base}_plus_int"} = {
        list   => $list,
        query  => sub {"+" . $_ [0]},
        wanted => sub {"+" . $_ [0], "+", $_ [0], $_ [0], "", ""}
    };
}

$targets {dot} = {
    list   => ['.'],
    query  => sub {$_ [0]},
};

sub __ {
    map {;"${_}_int",            "${_}_int_dot",
          "${_}_minus_int",      "${_}_plus_int",
          "${_}_dot_frac",       "${_}_minus_dot_frac", "${_}_plus_dot_frac",
    } @_
}

sub _2 {
    map {;"${_}_minus_int",      "${_}_plus_int",
          "${_}_minus_dot_frac", "${_}_plus_dot_frac",
    } @_
}

sub _3 {
    map {;"${_}_int",            "${_}_int_dot",
          "${_}_dot_frac",
    } @_
}

push @tests  => {
    name     =>  'basic',
    re       =>  $decimal,
    sub      =>  \&RE_num_decimal,
    pass     =>  [__ (grep {$_ <= 10} map {$$_ [0]} @data)],
    fail     =>  [__ (grep {$_ >  10} map {$$_ [0]} @data), "dot"],
};


push @tests  => {
    name     =>  'basic -- signed',
    re       =>  $decimal -> {-sign => '[-+]'},
    sub      =>  \&RE_num_decimal,
    sub_args =>  [-sign => '[-+]'],
    pass     =>  [ _2 (grep {$_ <= 10} map {$$_ [0]} @data)],
    fail     =>  [(_3 (grep {$_ <= 10} map {$$_ [0]} @data)),
                   __ (grep {$_ >  10} map {$$_ [0]} @data), "dot"],
};

foreach my $data (@data) {
    my $base     = $$data [0];
    my @passes   = __ grep {$_ <= $base} map {$$_ [0]} @data;
    my @failures = __ grep {$_ >  $base} map {$$_ [0]} @data;

    my @commas   = grep {/^${base}_.*comma/} keys %targets;

    push @tests  => {
        name     => "base_${base}",
        re       => $RE {num} {decimal} {-base => $base},
        sub      => \&RE_num_decimal,
        sub_args => [-base => $base],
        pass     => [@passes],
        fail     => [@failures, @commas, "dot"],
    };
    push @tests  => {
        name     => "base_${base}_comma",
        re       => $RE {num} {decimal} {-base => $base} {-radix => ","},
        sub      => \&RE_num_decimal,
        sub_args => [-base => $base, -radix => ","],
        pass     => [(grep {!/dot/} @passes), @commas],
        fail     => [(grep {/^${base}/} @failures)],
    };
}



run_new_tests  targets      => \%targets,
               tests        => \@tests,
               version_from => 'Regexp::Common::number',
;

__END__