#!/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,
    );
}

#
# Combine places and bases
#
my $min     = 3;
my $max     = 6;
my $pattern = make_test
  "Integer pattern" => $RE{num}{int},
  -base             => 4,
  -places           => "$min,$max";
my $pattern_neg = make_test
  "Integer pattern" => $RE{num}{int},
  -base             => 4,
  -places           => "$min,$max",
  -sign             => '[-]';

my @numbers;

push @numbers => map { "0" x $_ } 1 .. 7;
push @numbers => qw [
  1201201 21013 120 123100 3210310 1231231013 2130130 2130 31230
  13012302 13130
];

foreach my $number (@numbers) {
    my $length = length $number;
    if ( $length < $min ) {
        foreach my $subj ( $number, "-$number", "+$number" ) {
            $pattern->no_match( $number, reason => "Number too short" );
            $pattern_neg->no_match( $number, reason => "Number too short" );
        }
    }
    elsif ( $length > $max ) {
        foreach my $subj ( $number, "-$number", "+$number" ) {
            $pattern->no_match( $number, reason => "Number too long" );
            $pattern_neg->no_match( $number, reason => "Number too long" );
        }
    }
    else {
        $pattern->match(
            $number,
            [ $number, "", $number ],
            test => "Number of correct length"
        );
        $pattern_neg->no_match( $number, reason => "Number not signed" );
        $pattern->match(
            "-$number",
            [ "-$number", "-", $number ],
            test => "Signed number of correct length"
        );
        $pattern_neg->match(
            "-$number",
            [ "-$number", "-", $number ],
            test => "Signed number of correct length"
        );
        $pattern->match(
            "+$number",
            [ "+$number", "+", $number ],
            test => "Signed number of correct length"
        );
        $pattern_neg->no_match( $number,
            reason => "Number incorrectly signed" );
    }
}

my @bad_characters = (
    [ "Number contains space", "12 12", "111 1" ],
    [ "Digit exceeds base",    "1234",  "4", "121212124", "9123123123" ],
    [ "Letter in number",      "123A",  "Q", "202O20",    "123Z21" ],
);

foreach my $entry (@bad_characters) {
    my ( $reason, @subjs ) = @$entry;
    foreach my $subj (@subjs) {
        $pattern->no_match( $subj, reason => $reason );
        $pattern_neg->no_match( $subj, reason => $reason );
    }
}

done_testing();

__END__
