Make C<undef ~~ 0> and C<undef ~~ ""> not match (like in 5.10.0)

[p5sagit/p5-mst-13.2.git] / t / op / reg_posixcc.t

diff --git a/t/op/reg_posixcc.t b/t/op/reg_posixcc.t
index 7335399..f6391ef 100644 (file)
--- a/t/op/reg_posixcc.t
+++ b/t/op/reg_posixcc.t
@@ -7,7 +7,7 @@ BEGIN {
 
 use strict;
 use warnings;
-use Test::More tests => 1;
+use Test::More 'no_plan'; # otherwise it would 38401 tests, which is, uh, a lot. :-)
 my @pats=(
             "\\w",
            "\\W",
@@ -39,6 +39,10 @@ my @pats=(
            "[:^space:]",
            "[:blank:]",
            "[:^blank:]" );
+if (not $ENV{REAL_POSIX_CC}) {
+    $TODO = "Only works under PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS = 0";
+}
+
 sub rangify {
     my $ary= shift;
     my $fmt= shift || '%d';
@@ -72,6 +76,7 @@ while (@pats) {
     
     my %err_by_type;
     my %singles;
+    my %complements;
     foreach my $b (0..255) {
         my %got;
         for my $type ('unicode','not-unicode') {
@@ -80,7 +85,11 @@ while (@pats) {
                 $str.=chr(256);
                 chop $str;
             }
-            if ($str=~/[$yes][$no]/) {
+            if ($str=~/[$yes][$no]/){
+                TODO: {
+                    unlike($str,qr/[$yes][$no]/,
+                        "chr($b)=~/[$yes][$no]/ should not match under $type");
+                }
                 push @{$err_by_type{$type}},$b;
             }
             $got{"[$yes]"}{$type} = $str=~/[$yes]/ ? 1 : 0;
@@ -89,18 +98,33 @@ while (@pats) {
             $got{"[^$no]"}{$type} = $str=~/[^$no]/ ? 1 : 0;
         }
         foreach my $which ("[$yes]","[$no]","[^$yes]","[^$no]") {
-            if ($got{$which}{'unicode'} != $got{$which}{'not-unicode'}) {
+            if ($got{$which}{'unicode'} != $got{$which}{'not-unicode'}){
+                TODO: {
+                    is($got{$which}{'unicode'},$got{$which}{'not-unicode'},
+                        "chr($b)=~/$which/ should have the same results regardless of internal string encoding");
+                }
                 push @{$singles{$which}},$b;
             }
         }
+        foreach my $which ($yes,$no) {
+            foreach my $strtype ('unicode','not-unicode') {
+                if ($got{"[$which]"}{$strtype} == $got{"[^$which]"}{$strtype}) {
+                    TODO: {
+                        isnt($got{"[$which]"}{$strtype},$got{"[^$which]"}{$strtype},
+                            "chr($b)=~/[$which]/ should not have the same result as chr($b)=~/[^$which]/");
+                    }
+                    push @{$complements{$which}{$strtype}},$b;
+                }
+            }
+        }
     }
     
     
-    if (%err_by_type || %singles) {
+    if (%err_by_type || %singles || %complements) {
         $description||=" Error:\n";
         $description .= "/[$yes][$no]/\n";
         if (%err_by_type) {
-            foreach my $type (keys %err_by_type) {
+            foreach my $type (sort keys %err_by_type) {
                 $description .= "\tmatches $type codepoints:\t";
                 $description .= rangify($err_by_type{$type});
                 $description .= "\n";
@@ -109,19 +133,26 @@ while (@pats) {
         }
         if (%singles) {
             $description .= "Unicode/Nonunicode mismatches:\n";
-            foreach my $type (keys %singles) {
+            foreach my $type (sort keys %singles) {
                 $description .= "\t$type:\t";
                 $description .= rangify($singles{$type});
                 $description .= "\n";
             }
             $description .= "\n";
         }
-     
+        if (%complements) {
+            foreach my $class (sort keys %complements) {
+                foreach my $strtype (sort keys %{$complements{$class}}) {
+                    $description .= "\t$class has complement failures under $strtype for:\t";
+                    $description .= rangify($complements{$class}{$strtype});
+                    $description .= "\n";
+                }
+            }
+        }
     }
-    
 }
 TODO: {
-    local $TODO = "Only works under PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS = 0";
     is( $description, "", "POSIX and perl charclasses should not depend on string type");
-};
+}
+
 __DATA__