#!/usr/bin/perl

use strict;
use warnings;
no warnings 'syntax';

use Regex::Common;
use Test::More;

my $r = eval "require Test::Regexp; 1";

unless ($r) {
    print "1..0 # SKIP Test::Regexp not found\n";
    exit;
}

sub make_test {
    my ( $name, $base, @options ) = @_;
    my $pat = $base;
    while (@options) {
        my $opt = shift @options;
        if ( @options && $options[0] !~ /^-/ ) {
            my $val = shift @options;
            $pat = $$pat{ $opt => $val };
            $name .= ", $opt => $val";
        }
        else {
            $pat = $$pat{$opt};
            $name .= ", $opt";
        }
    }
    my $keep = $$pat{-keep};
    Test::Regexp::->new->init(
        pattern      => $pat,
        keep_pattern => $keep,
        name         => $name,
    );
}

my $pattern_c = make_test
  "Integer pattern" => $RE{num}{int},
  -sep              => ",";
my $pattern_u = make_test
  "Integer pattern" => $RE{num}{int},
  -sep              => "_";

my @pass_numbers = qw [
  0 00 000 123 45 6
  123,456 78,901 2,345
  0,000,000,000,000,000,000,000,000,000,000,000,000
  00,000,000,000,000,000,000,000,000,000,000,000,000
  000,000,000,000,000,000,000,000,000,000,000,000,000
  5,098,145,984,398,345 2,831,471,982 38,247,113,284,912 7,312,834
  8,732,123,847,132 45,884,573 99,234,759,141 27,348,134,581 214,357,191
];

foreach my $number (@pass_numbers) {
    my $sep_c = $number =~ y/,/,/;
    my $test =
        $sep_c == 0 ? "No separator"
      : $sep_c == 1 ? "Single separator"
      :               "Multiple separators";
    $pattern_c->match(
        $number => [ $number, "", $number ],
        test    => $test
    );
    $pattern_c->match(
        "-$number" => [ "-$number", "-", $number ],
        test       => "$test, signed (-)"
    );
    $pattern_c->match(
        "+$number" => [ "+$number", "+", $number ],
        test       => "$test, signed (+)"
    );

    $number =~ s/,/_/g;
    $pattern_u->match(
        $number => [ $number, "", $number ],
        test    => $test
    );
    $pattern_u->match(
        "-$number" => [ "-$number", "-", $number ],
        test       => "$test, signed (-)"
    );
    $pattern_u->match(
        "+$number" => [ "+$number", "+", $number ],
        test       => "$test, signed (+)"
    );
}

my @failures = (
    [ "Wrong separator"    => qw [0.000 1,234_456,789], "100 123" ],
    [ "Leading separator"  => qw [,123 ,456,789] ],
    [ "Trailing separator" => qw [123, 456,789,] ],
    [ "Double separator"   => qw [0,,000 123,456,,789] ],
    [ "No digits"          => qw [, ,,] ],
    [
        "Wrong number of digits in group" =>
          qw [1,23,456 1,2345,678 489,1234,345,169,000]
    ],
    [ "Wrong number of digits in last group" => qw [123,4567 456,78] ],
    [
        "Too many leading digits" =>
          qw [1234,567 0000,000,000 8129132412341,000]
    ],
    [
        "Trailing garbage" => qw [123,456,789foo 000,bar],
        "123,456 ",
        "987,543,611\n"
    ],
    [ "Leading garbage" => qw [baz,123,456 qux,000], " 123,456" ],
    [ "Inner garbage"   => qw [123,foo,456 1a3,456], "123, 456" ],
    [ "Empty string"    => "" ],
    [ "Garbage"         => "wibble", "\n", "foo,123,bar" ],
);

foreach my $failure (@failures) {
    my ( $reason, @subjects ) = @$failure;
    foreach my $subject (@subjects) {
        $pattern_c->no_match( $subject, reason => $reason );
    }
}

done_testing();

__END__
