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

#
# Play with -base.
#
my @bases = ( 2, 5, 8, 16, 23, 36 );
my %patterns;
my $PLAIN  = 0;
my $SIGNED = 1;
foreach my $base (@bases) {
    my $plain = make_test "Base $base integer pattern",
      $RE{num}{int}, -base => $base;
    my $signed = make_test "Base $base integer pattern", $RE{num}{int},
      -base => $base,
      -sign => '[-+]';
    $patterns{$base} = [ $plain, $signed ];
}

my @chars = ( 0 .. 9, 'A' .. 'Z' );
for ( my $i = 0 ; $i < @chars ; $i++ ) {
    my $char = $chars[$i];
    foreach my $base (@bases) {
        if ( $i < $base ) {
            my $subj = $char;
            $patterns{$base}[$PLAIN]->match(
                $subj,
                [ $subj, "", $char ],
                test => "Single character in base"
            );
            $patterns{$base}[$SIGNED]
              ->no_match( $subj, reason => "Not signed" );
            $subj = "-$char";
            $patterns{$base}[$PLAIN]->match(
                $subj,
                [ $subj, "-", $char ],
                test => "Signed (-) single character in base",
            );
            $patterns{$base}[$SIGNED]->match(
                $subj,
                [ $subj, "-", $char ],
                test => "Signed (-) single character in base",
            );
            $subj = "+$char";
            $patterns{$base}[$PLAIN]->match(
                $subj,
                [ $subj, "+", $char ],
                test => "Signed (+) single character in base",
            );
            $patterns{$base}[$SIGNED]->match(
                $subj,
                [ $subj, "+", $char ],
                test => "Signed (+) single character in base",
            );
        }
        else {
            for my $subj ( $char, "-$char", "+$char" ) {
                $patterns{$base}[$PLAIN]->no_match( $subj,
                    reason => "Character '$char' out of base $base" );
            }
        }
    }
}

my $numbers = [
    '00',
    '00000000000000000000',
    '0' x 100_000,
    '11',
    '10101010101010101010',
    '11010100110100100111',
    '12234',
    '4321',
    '1234' x 10_000,
    '00000000000000000000000000000000000000000030000000000000',
    '444444444444444444444444444444444444',
    '1234567',
    '7654321',
    '12435147126123471234651263154211451235',
    '412377132477712347716234512374712341541',
    '2378AB21394CFF9932841EFFA9234',
    'DEADBEEF',
    'BABEFACE',
    '87134F13241',
    'FEDCBA9876543210' x 1_000,
    'ASTORYWELLTOLD',
    'BETTERL8THENNEVER',
    '4SALE',
    'AS08142H5A87SDFYOUY4YR09TWRE7YGUASDFA99Q0ASHNR1KF98QERTOQ2C871C123R',
    'AL0NGSTR1NGR3P34T3DM4NYT1M3S' x 3_000
];
my %numbers_by_base;
NUMBER: foreach my $number (@$numbers) {
    my %buckets;
    $buckets{$_}++ for split // => $number;
    for ( my $i = @chars - 1 ; $i >= 0 ; $i-- ) {
        if ( $buckets{ $chars[$i] } ) {
            push @{ $numbers_by_base{ $i + 1 } } => $number;
            next NUMBER;
        }
    }
}
my @base_numbers = sort { $a <=> $b } keys %numbers_by_base;

foreach my $base (@bases) {
    my ( $pattern, $signed_pattern ) = @{ $patterns{$base} };
    foreach my $base_number (@base_numbers) {
        foreach my $number ( @{ $numbers_by_base{$base_number} } ) {
            my $is_big      = length($number) > 100;
            my $desc_number = $is_big ? "big number" : "number";
            if ( $base >= $base_number ) {
                my $subj = $number;
                $pattern->match(
                    $subj,
                    [ $subj, "", $number ],
                    test => "Unsigned $desc_number"
                );
                $signed_pattern->no_match( $subj,
                    reason => "No sign for $desc_number" );
                $subj = "-$number";
                $pattern->match(
                    $subj,
                    [ $subj, "-", $number ],
                    test => "Signed (-) $desc_number"
                );
                $signed_pattern->match(
                    $subj,
                    [ $subj, "-", $number ],
                    test => "Signed (-) $desc_number"
                );
                $subj = "+$number";
                $pattern->match(
                    $subj,
                    [ $subj, "+", $number ],
                    test => "Signed (+) $desc_number"
                );
                $signed_pattern->match(
                    $subj,
                    [ $subj, "+", $number ],
                    test => "Signed (+) $desc_number"
                );
            }
            else {
                foreach my $subj ( $number, "-$number", "+$number" ) {
                    $pattern->no_match( $subj,
                        reason => "Out of base characters" );
                    $signed_pattern->no_match( $subj,
                        reason => "Out of base characters" );
                }
            }
        }
    }
}

done_testing();

__END__
