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