do subname() is deprecated, so update this hunk of test dating from perl 1.

[p5sagit/p5-mst-13.2.git] / t / re / pat_special_cc.t

#!./perl
#
# This test file is used to bulk check that /\s/ and /[\s]/ 
# test the same and that /\s/ and /\S/ are opposites, and that
# /[\s]/ and /[\S]/ are also opposites, for \s/\S and \d/\D and 
# \w/\W.
use strict;
use warnings;
use 5.010;


sub run_tests;

$| = 1;


BEGIN {
    chdir 't' if -d 't';
    @INC = ('../lib','.');
    do "re/ReTest.pl" or die $@;
}


plan tests => 9;  # Update this when adding/deleting tests.

run_tests() unless caller;

#
# Tests start here.
#
sub run_tests {
    my $upper_bound= 10_000;
    for my $special (qw(\s \w \d)) {
        my $upper= uc($special);
        my @cc_plain_failed;
        my @cc_complement_failed;
        my @plain_complement_failed;
        for my $ord (0 .. $upper_bound) {
            my $ch= chr $ord;
            my $plain= $ch=~/$special/ ? 1 : 0;
            my $plain_u= $ch=~/$upper/ ? 1 : 0;
            push @plain_complement_failed, "$ord-$plain-$plain_u" if $plain == $plain_u;

            my $cc= $ch=~/[$special]/ ? 1 : 0;
            my $cc_u= $ch=~/[$upper]/ ? 1 : 0;
            push @cc_complement_failed, "$ord-$cc-$cc_u" if $cc == $cc_u;

            push @cc_plain_failed, "$ord-$plain-$cc" if $plain != $cc;
        }
        iseq(join(" | ",@cc_plain_failed),"", "Check that /$special/ and /[$special]/ match same things (ord-plain-cc)");
        iseq(join(" | ",@plain_complement_failed),"", "Check that /$special/ and /$upper/ are complements (ord-plain-plain_u)");
        iseq(join(" | ",@cc_complement_failed),"", "Check that /[$special]/ and /[$upper]/ are complements (ord-cc-cc_u)");
    }
} # End of sub run_tests

1;