10 use Test::More tests => 1;
44 my $fmt= shift || '%d';
45 my $sep= shift || ' ';
46 my $rng= shift || '..';
51 my $ret= sprintf $fmt, $first;
52 for my $idx (1..$#$ary) {
53 if ( $ary->[$idx] != $last + 1) {
55 $ret.=sprintf "%s$fmt",$rng, $last;
57 $first= $last= $ary->[$idx];
58 $ret.=sprintf "%s$fmt",$sep,$first;
63 if ( $last != $first) {
64 $ret.=sprintf "%s$fmt",$rng, $last;
71 my ($yes,$no)= splice @pats,0,2;
75 foreach my $b (0..255) {
77 for my $type ('unicode','not-unicode') {
78 my $str=chr($b).chr($b);
79 if ($type eq 'unicode') {
83 if ($str=~/[$yes][$no]/) {
84 push @{$err_by_type{$type}},$b;
86 $got{"[$yes]"}{$type} = $str=~/[$yes]/ ? 1 : 0;
87 $got{"[$no]"}{$type} = $str=~/[$no]/ ? 1 : 0;
88 $got{"[^$yes]"}{$type} = $str=~/[^$yes]/ ? 1 : 0;
89 $got{"[^$no]"}{$type} = $str=~/[^$no]/ ? 1 : 0;
91 foreach my $which ("[$yes]","[$no]","[^$yes]","[^$no]") {
92 if ($got{$which}{'unicode'} != $got{$which}{'not-unicode'}) {
93 push @{$singles{$which}},$b;
99 if (%err_by_type || %singles) {
100 $description||=" Error:\n";
101 $description .= "/[$yes][$no]/\n";
103 foreach my $type (keys %err_by_type) {
104 $description .= "\tmatches $type codepoints:\t";
105 $description .= rangify($err_by_type{$type});
106 $description .= "\n";
108 $description .= "\n";
111 $description .= "Unicode/Nonunicode mismatches:\n";
112 foreach my $type (keys %singles) {
113 $description .= "\t$type:\t";
114 $description .= rangify($singles{$type});
115 $description .= "\n";
117 $description .= "\n";
124 local $TODO = "Only works under PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS = 0";
125 is( $description, "", "POSIX and perl charclasses should not depend on string type");