Upgrade to Tie::File 0.20.

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

diff --git a/t/op/pat.t b/t/op/pat.t
index 9b4fb13..4fb3d45 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..855\n";
+print "1..860\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1933,20 +1933,26 @@ print "ok 671\n";
 print "not " unless chr(0x38c) =~ /\p{IsGreek}/; # singleton
 print "ok 672\n";
 
+if (ord("A") == 65) {
 ##
 ## Test [:cntrl:]...
 ##
 ## Should probably put in tests for all the POSIX stuff, but not sure how to
 ## guarantee a specific locale......
 ##
-$AllBytes = join('', map { chr($_) } 0..255);
-($x = $AllBytes) =~ s/[[:cntrl:]]//g;
-if ($x ne join('', map { chr($_) } 0x20..0x7E, 0x80..0xFF)) { print "not " };
-print "ok 673\n";
+    $AllBytes = join('', map { chr($_) } 0..255);
+    ($x = $AllBytes) =~ s/[[:cntrl:]]//g;
+    if ($x ne join('', map { chr($_) } 0x20..0x7E, 0x80..0xFF)) {
+       print "not ";
+    }
+    print "ok 673\n";
 
-($x = $AllBytes) =~ s/[^[:cntrl:]]//g;
-if ($x ne join('', map { chr($_) } 0..0x1F, 0x7F)) { print "not " };
-print "ok 674\n";
+    ($x = $AllBytes) =~ s/[^[:cntrl:]]//g;
+    if ($x ne join('', map { chr($_) } 0..0x1F, 0x7F)) { print "not " }
+    print "ok 674\n";
+} else {
+    print "ok $_ # Skip: EBCDIC\n" for 673..674;
+}
 
 # With /s modifier UTF8 chars were interpreted as bytes
 {
@@ -2284,7 +2290,7 @@ print "# some Unicode properties\n";
     print "not " unless "a\x{100}" =~ /A/i;
     print "ok 754\n";
 
-    print "not " unless "A\x{100}" =~ /A/i;
+    print "not " unless "A\x{100}" =~ /a/i;
     print "ok 755\n";
 
     print "not " unless "a\x{100}" =~ /a/i;
@@ -2308,7 +2314,7 @@ print "# some Unicode properties\n";
     print "not " unless "a\x{100}" =~ /A\x{100}/i;
     print "ok 762\n";
 
-    print "not " unless "A\x{100}" =~ /A\x{100}/i;
+    print "not " unless "A\x{100}" =~ /a\x{100}/i;
     print "ok 763\n";
 
     print "not " unless "a\x{100}" =~ /a\x{100}/i;
@@ -2320,7 +2326,7 @@ print "# some Unicode properties\n";
     print "not " unless "a\x{100}" =~ /[A]/i;
     print "ok 766\n";
 
-    print "not " unless "A\x{100}" =~ /[A]/i;
+    print "not " unless "A\x{100}" =~ /[a]/i;
     print "ok 767\n";
 
     print "not " unless "a\x{100}" =~ /[a]/i;
@@ -2669,17 +2675,34 @@ print "# some Unicode properties\n";
 }
 
 {
-    print "# [ID 20020124.005]\n";
+    print "# UTF-8 hash keys and /\$/\n";
+    # http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2002-01/msg01327.html
+
+    my $u = "a\x{100}";
+    my $v = substr($u,0,1);
+    my $w = substr($u,1,1);
+    my %u = ( $u => $u, $v => $v, $w => $w );
+    my $i = 855; 
+    for (keys %u) {
+       my $m1 = /^\w*$/ ? 1 : 0;
+       my $m2 = $u{$_}=~/^\w*$/ ? 1 : 0;
+       print $m1 == $m2 ? "ok $i\n" : "not ok $i # $m1 $m2\n";
+       $i++;
+    }
+}
 
+{
+    print "# [ID 20020124.005]\n";
     # Fixed by #14795.
-
-    $char = "\x{f00f}";
-    $x = "$char b $char";
-
-    $x =~ s{($char)}{
-       "c" =~ /d/;
-       "x";
-    }ge;
-
-    print $x eq "x b x" ? "ok 855\n" : "not ok 855\n";
+    my $i = 858;
+    for my $char ("a", "\x{df}", "\x{100}"){
+       $x = "$char b $char";
+       $x =~ s{($char)}{
+           "c" =~ /c/;
+           "x";
+       }ge;
+       print substr($x,0,1) eq substr($x,-1,1) ?
+           "ok $i\n" : "not ok $i # debug: $x\n";
+       $i++;
+   }
 }