Forgot the latest mktables.PL from #9899.

[perl5.git] / t / op / pat.t

diff --git a/t/op/pat.t b/t/op/pat.t
index a66ea45..9130454 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,16 +4,17 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-print "1..581\n";
+$| = 1;
+print "1..587\n";
 
 BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
-eval 'use Config';          #  Defaults assumed if this fails
 
-# XXX known to leak scalars
-$ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3;
+use re 'asciirange'; # Compute ranges in ASCII space
+
+eval 'use Config';          #  Defaults assumed if this fails
 
 $x = "abc\ndef\n";
 
@@ -73,24 +74,23 @@ $* = 1;             # test 3 only tested the optimized version--this one is for real
 if ("ab\ncd\n" =~ /^cd/) {print "ok 24\n";} else {print "not ok 24\n";}
 $* = 0;
 
-#$XXX{123} = 123;
-#$XXX{234} = 234;
-#$XXX{345} = 345;
-#
-#@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
-#while ($_ = shift(@XXX)) {
-#    ?(.*)? && (print $1,"\n");
-#    /not/ && reset;
-#    /not ok 26/ && reset 'X';
-#}
-#
-#while (($key,$val) = each(%XXX)) {
-#    print "not ok 27\n";
-#    exit;
-#}
-#
-#print "ok 27\n";
-for (25..27) { print "ok $_\n" }
+$XXX{123} = 123;
+$XXX{234} = 234;
+$XXX{345} = 345;
+
+@XXX = ('ok 25','not ok 25', 'ok 26','not ok 26','not ok 27');
+while ($_ = shift(@XXX)) {
+    ?(.*)? && (print $1,"\n");
+    /not/ && reset;
+    /not ok 26/ && reset 'X';
+}
+
+while (($key,$val) = each(%XXX)) {
+    print "not ok 27\n";
+    exit;
+}
+
+print "ok 27\n";
 
 'cde' =~ /[^ab]*/;
 'xyz' =~ //;
@@ -1133,8 +1133,6 @@ $test++;
 $_ = "a\x{100}b";
 if (/(.)(\C)(\C)(.)/) {
   print "ok 232\n";
-  # currently \C are still tagged as UTF-8
-  use bytes;
   if ($1 eq "a") {
     print "ok 233\n";
   } else {
@@ -1164,7 +1162,6 @@ $_ = "\x{100}";
 if (/(\C)/g) {
   print "ok 237\n";
   # currently \C are still tagged as UTF-8
-  use bytes;
   if ($1 eq "\xC4") {
     print "ok 238\n";
   } else {
@@ -1178,7 +1175,6 @@ if (/(\C)/g) {
 if (/(\C)/g) {
   print "ok 239\n";
   # currently \C are still tagged as UTF-8
-  use bytes;
   if ($1 eq "\x80") {
     print "ok 240\n";
   } else {
@@ -1231,7 +1227,7 @@ if (ord('i') == 0x89 && ord('J') == 0xd1) { # EBCDIC
   }
 } else {
   for (244..245) {
-    print "ok $_ # Skip: not EBCDIC\n";
+    print "ok $_ # Skip: only in EBCDIC\n";
   }
 }
 
@@ -1551,3 +1547,39 @@ print "ok 247\n";
 
     print "ok 581\n";
 }
+
+{
+    $test = 582;
+
+    # bugid 20010410.006
+    for my $rx (
+               '/(.*?)\{(.*?)\}/csg',
+               '/(.*?)\{(.*?)\}/cg',
+               '/(.*?)\{(.*?)\}/sg',
+               '/(.*?)\{(.*?)\}/g',
+               '/(.+?)\{(.+?)\}/csg',
+              )
+    {
+       my($input, $i);
+
+       $i = 0;
+       $input = "a{b}c{d}";
+        eval <<EOT;
+       while (eval \$input =~ $rx) {
+           print "# \\\$1 = '\$1' \\\$2 = '\$2'\n";
+           ++\$i;
+       }
+EOT
+       print "not " unless $i == 2;
+       print "ok " . $test++ . "\n";
+    }
+}
+
+{
+    # from Robin Houston
+
+    my $x = "\x{12345678}";
+    $x =~ s/(.)/$1/g;
+    print "not " unless ord($x) == 0x12345678 && length($x) == 1;
+    print "ok 587\n";
+}