summaryrefslogtreecommitdiff
path: root/t/re/pat_special_cc.t
blob: 4bd8c4a86c6c57bd488bd0028ec2b61c26e23f96 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
#!./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.

BEGIN {
    chdir 't' if -d 't';
    require './test.pl';
    set_up_inc( '../lib', '.' );
}

use strict;
use warnings;
use 5.010;

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

sub run_tests;

$| = 1;

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 $ord = sprintf "U+%04X", $ord;  # For display in Unicode terms
            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;
        }
        is(join(" | ",@cc_plain_failed),"", "Check that /$special/ and /[$special]/ match same things (ord-plain-cc)");
        is(join(" | ",@plain_complement_failed),"", "Check that /$special/ and /$upper/ are complements (ord-plain-plain_u)");
        is(join(" | ",@cc_complement_failed),"", "Check that /[$special]/ and /[$upper]/ are complements (ord-cc-cc_u)");
    }
} # End of sub run_tests

1;