10 use Test::More 'no_plan'; # otherwise it would 38401 tests, which is, uh, a lot. :-)
42 if (not $ENV{REAL_POSIX_CC}) {
43 $TODO = "Only works under PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS = 0";
48 my $fmt= shift || '%d';
49 my $sep= shift || ' ';
50 my $rng= shift || '..';
55 my $ret= sprintf $fmt, $first;
56 for my $idx (1..$#$ary) {
57 if ( $ary->[$idx] != $last + 1) {
59 $ret.=sprintf "%s$fmt",$rng, $last;
61 $first= $last= $ary->[$idx];
62 $ret.=sprintf "%s$fmt",$sep,$first;
67 if ( $last != $first) {
68 $ret.=sprintf "%s$fmt",$rng, $last;
75 my ($yes,$no)= splice @pats,0,2;
80 foreach my $b (0..255) {
82 for my $type ('unicode','not-unicode') {
83 my $str=chr($b).chr($b);
84 if ($type eq 'unicode') {
88 if ($str=~/[$yes][$no]/){
90 unlike($str,qr/[$yes][$no]/,
91 "chr($b)=~/[$yes][$no]/ should not match under $type");
93 push @{$err_by_type{$type}},$b;
95 $got{"[$yes]"}{$type} = $str=~/[$yes]/ ? 1 : 0;
96 $got{"[$no]"}{$type} = $str=~/[$no]/ ? 1 : 0;
97 $got{"[^$yes]"}{$type} = $str=~/[^$yes]/ ? 1 : 0;
98 $got{"[^$no]"}{$type} = $str=~/[^$no]/ ? 1 : 0;
100 foreach my $which ("[$yes]","[$no]","[^$yes]","[^$no]") {
101 if ($got{$which}{'unicode'} != $got{$which}{'not-unicode'}){
103 is($got{$which}{'unicode'},$got{$which}{'not-unicode'},
104 "chr($b)=~/$which/ should have the same results regardless of internal string encoding");
106 push @{$singles{$which}},$b;
109 foreach my $which ($yes,$no) {
110 foreach my $strtype ('unicode','not-unicode') {
111 if ($got{"[$which]"}{$strtype} == $got{"[^$which]"}{$strtype}) {
113 isnt($got{"[$which]"}{$strtype},$got{"[^$which]"}{$strtype},
114 "chr($b)=~/[$which]/ should not have the same result as chr($b)=~/[^$which]/");
116 push @{$complements{$which}{$strtype}},$b;
123 if (%err_by_type || %singles || %complements) {
124 $description||=" Error:\n";
125 $description .= "/[$yes][$no]/\n";
127 foreach my $type (sort keys %err_by_type) {
128 $description .= "\tmatches $type codepoints:\t";
129 $description .= rangify($err_by_type{$type});
130 $description .= "\n";
132 $description .= "\n";
135 $description .= "Unicode/Nonunicode mismatches:\n";
136 foreach my $type (sort keys %singles) {
137 $description .= "\t$type:\t";
138 $description .= rangify($singles{$type});
139 $description .= "\n";
141 $description .= "\n";
144 foreach my $class (sort keys %complements) {
145 foreach my $strtype (sort keys %{$complements{$class}}) {
146 $description .= "\t$class has complement failures under $strtype for:\t";
147 $description .= rangify($complements{$class}{$strtype});
148 $description .= "\n";
155 is( $description, "", "POSIX and perl charclasses should not depend on string type");