(retracted by #16560)
[p5sagit/p5-mst-13.2.git] / t / op / pat.t
index 905204b..971ca71 100755 (executable)
@@ -6,7 +6,7 @@
 
 $| = 1;
 
-print "1..908\n";
+print "1..910\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -1276,19 +1276,27 @@ print "not " unless "\x{abcd}" =~ /\x{abcd}/;
 print "ok 247\n";
 
 {
-    # bug id 20001008.001
-
-    my $test = 248;
-    my @x = ("stra\337e 138","stra\337e 138");
-    for (@x) {
-       s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
-       my($latin) = /^(.+)(?:\s+\d)/;
-       print $latin eq "stra\337e" ? "ok $test\n" :    # 248,249
-           "#latin[$latin]\nnot ok $test\n";
-       $test++;
-       $latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
-       use utf8; # needed for the raw UTF-8
-       $latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a
+    if (ord("ß") == 0337) { # Latin-1 only.
+       # bug id 20001008.001
+
+       eval <<'__EOT__';
+       my $test = 248;
+       my @x = ("stra\337e 138","stra\337e 138");
+       for (@x) {
+           s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
+           my($latin) = /^(.+)(?:\s+\d)/;
+           print $latin eq "stra\337e" ? "ok $test\n" :        # 248,249
+               "#latin[$latin]\nnot ok $test\n";
+           $test++;
+           $latin =~ s/stra\337e/straße/; # \303\237 after the 2nd a
+           use utf8; # needed for the raw UTF-8
+           $latin =~ s!(s)tr(?:aß|s+e)!$1tr.!; # \303\237 after the a
+       }
+__EOT__
+    } else {
+       for (248..249) {
+           print "ok $_ # Skip: only in Latin-1\n";
+        }
     }
 }
 
@@ -2870,3 +2878,17 @@ print "\x{3040}" =~ /\P{InKana3}/ ? "ok $test\n" : "not ok $test\n"; $test++;
 print "\x{3040}" =~ /\p{InNotKana}/ ? "ok $test\n" : "not ok $test\n"; $test++;
 print "\x{3041}" =~ /\P{InNotKana}/ ? "ok $test\n" : "not ok $test\n"; $test++;
 
+sub InConsonant { # Not EBCDIC-aware.
+    return <<EOF;
+0061   007f
+-0061
+-0065
+-0069
+-006f
+-0075
+EOF
+}
+
+print "d" =~ /\p{InConsonant}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+print "e" =~ /\P{InConsonant}/ ? "ok $test\n" : "not ok $test\n"; $test++;
+