This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate nok() from ReTest.pl by refactoring all uses to other test functions.
[perl5.git] / t / re / pat_special_cc.t
CommitLineData
ad69478d
YO
1#!./perl
2#
3# This test file is used to bulk check that /\s/ and /[\s]/
4# test the same and that /\s/ and /\S/ are opposites, and that
5# /[\s]/ and /[\S]/ are also opposites, for \s/\S and \d/\D and
6# \w/\W.
7use strict;
8use warnings;
9use 5.010;
10
11
12sub run_tests;
13
14$| = 1;
15
16
17BEGIN {
18 chdir 't' if -d 't';
19 @INC = ('../lib','.');
20 do "re/ReTest.pl" or die $@;
21}
22
23
24plan tests => 9; # Update this when adding/deleting tests.
25
26run_tests() unless caller;
27
28#
29# Tests start here.
30#
31sub run_tests {
32 my $upper_bound= 10_000;
33 for my $special (qw(\s \w \d)) {
34 my $upper= uc($special);
35 my @cc_plain_failed;
36 my @cc_complement_failed;
37 my @plain_complement_failed;
38 for my $ord (0 .. $upper_bound) {
39 my $ch= chr $ord;
c2dc4c7d 40 my $ord = sprintf "U+%04X", $ord; # For display in Unicode terms
ad69478d
YO
41 my $plain= $ch=~/$special/ ? 1 : 0;
42 my $plain_u= $ch=~/$upper/ ? 1 : 0;
43 push @plain_complement_failed, "$ord-$plain-$plain_u" if $plain == $plain_u;
44
45 my $cc= $ch=~/[$special]/ ? 1 : 0;
46 my $cc_u= $ch=~/[$upper]/ ? 1 : 0;
47 push @cc_complement_failed, "$ord-$cc-$cc_u" if $cc == $cc_u;
48
49 push @cc_plain_failed, "$ord-$plain-$cc" if $plain != $cc;
50 }
51 iseq(join(" | ",@cc_plain_failed),"", "Check that /$special/ and /[$special]/ match same things (ord-plain-cc)");
52 iseq(join(" | ",@plain_complement_failed),"", "Check that /$special/ and /$upper/ are complements (ord-plain-plain_u)");
53 iseq(join(" | ",@cc_complement_failed),"", "Check that /[$special]/ and /[$upper]/ are complements (ord-cc-cc_u)");
54 }
55} # End of sub run_tests
56
571;