view release on metacpan or  search on metacpan

share/RegexpCommonTS/t/number/integer.t  view on Meta::CPAN

$targets {words} = {
    list   =>  \@words,
};
$targets {garbage} = {
    list   =>  \@garbage,
    query  =>  sub {("", "+", "-") [rand 3] . $_ [0]},
};
$targets {small_garbage} = {
    list   =>  [sample $bad_size, @garbage],
    query  =>  sub {("", "+", "-") [rand 3] . $_ [0]},
};


push @tests => {
    name    => "integer",
    re      => $RE {num} {int},
    sub     => \&RE_num_int,
    pass    => [ map {;"u$_", "+$_", "-$_"} grep {$_ && $_ <= 10} @bases],
    fail    => [(map {;"u$_", "+$_", "-$_"} grep {$_ && $_  > 10} @bases),
                "words", "garbage", "dot10", "sign10"],
};


my @pairs = map {my $n = $_; map {[$n, $_]} $n + 1 .. $max_length
                } 1 .. $max_length;

foreach my $i (1 .. $#bases) {
    my $base = $bases [$i];
    push @tests  => {
        name     => "-base=$base",
        re       => $RE {num} {int} {-base => $base},
        sub      => \&RE_num_int,
        sub_args => [-base => $base],
        pass     => [ map {;"u$_", "+$_", "-$_"}
                      grep {$_ && $_ <= $base} @bases],
        fail     => [(map {;"u$_", "+$_", "-$_"}
                      grep {$_ && $_  > $base} @bases),
                    "words", "garbage", "dot$base", "sign$base"],
    };

    foreach my $group (@group_sizes) {
        push @tests  => {
            name     => "-base=$base; -group=$group",
            re       => $RE {num} {int} {-base => $base} {-group => $group}
                                        {-sep},
            sub      => \&RE_num_int,
            sub_args => [-base => $base, -group => $group, -sep =>],
            pass     => [  "sep-$base-$group",
                         "+-sep-$base-$group",
                         "--sep-$base-$group",],
            fail     => [  "sep-$base-$too_long",
                         "+-sep-$base-$too_long",
                         "--sep-$base-$too_long",
                         "small_garbage"],
        };
        # Fail if the base is upped.
        next if $i == $#bases;
        my $next_base = $bases [$i + 1];
        push @{$tests [-1] {fail}} => "sep-$next_base-$group" 
               unless $[ < 5.00503;
    }

    push @tests  => {
        name     => "-base=$base; -sep; " .
                    "-group=$group_sizes[0],$group_sizes[-1]",
        re       => $RE {num} {int}
                              {-base  =>  $base}
                              {-group => "$group_sizes[0],$group_sizes[-1]"}
                              {-sep},
        sub      => \&RE_num_int,
        sub_args => [-base  => $base,
                     -group => "$group_sizes[0],$group_sizes[-1]",
                     -sep   =>],
        pass     => [ map {;"sep-$base-$_",
                          "+-sep-$base-$_",
                          "--sep-$base-$_"} @group_sizes],
        fail     => [  "sep-$base-$too_long",
                     "+-sep-$base-$too_long",
                     "--sep-$base-$too_long",
                     "garbage"],
    };

    foreach my $length (1 .. $max_length) {
        push @tests  => {
            name     => "-base=$base; -places=$length",
            re       => $RE {num} {int} {-base => $base} {-places => $length},
            sub      => \&RE_num_int,
            sub_args => [-base => $base, -places => $length],
            pass     => ["exact-$base-$length",
                       "+-exact-$base-$length",
                       "--exact-$base-$length"],
            fail     => ["small_garbage",
                         map  {;"exact-$base-$_"}
                         grep {$_ ne $length} 1 .. $max_length],
        }
    }

    #
    # Eh, I don't like this. Too much randomness makes that the number
    # of tests isn't constant.
    #
    foreach my $pair (sample $mini_size, @pairs) {
        my ($low, $high) = @$pair;
        push @tests  => {
            name     => "-base=$base; -places=$low,$high",
            re       => $RE {num} {int} {-base => $base}
                                        {-places => "$low,$high"},
            sub      => \&RE_num_int,
            sub_args => [-base => $base, -places => "$low,$high"],
            pass     => [map {;"exact-$base-$_",
                             "+-exact-$base-$_",
                             "--exact-$base-$_",}
                         sample $mini_size,
                                 grep {$low <= $_ && $_ <= $high}
                                 1 .. $max_length],
            fail     => ["small_garbage",
                         sample $mini_size, map  {;"exact-$base-$_"}
                                            grep {$_ < $low || $high < $_}
                                            1 .. $max_length],
        }