This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Eliminate $::PatchId from t/re/*.t.
[perl5.git] / t / re / pat_rt_report.t
index efbbe8f..c5c530a 100644 (file)
@@ -15,13 +15,17 @@ $| = 1;
 
 
 BEGIN {
+    if (!defined &DynaLoader::boot_DynaLoader) {
+       print "1..0 # Skip miniperl can't load Tie::Hash::NamedCapture, need for %+ and %-\n";
+       exit 0;
+    }
     chdir 't' if -d 't';
     @INC = ('../lib','.');
     do "re/ReTest.pl" or die $@;
 }
 
 
-plan tests => 2511;  # Update this when adding/deleting tests.
+plan tests => 2514;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -34,7 +38,7 @@ sub run_tests {
     {
         local $BugId = '20000731.001';
         ok "A \x{263a} B z C" =~ /A . B (??{ "z" }) C/,
-           "Match UTF-8 char in presense of (??{ })";
+           "Match UTF-8 char in presence of (??{ })";
     }
 
 
@@ -206,8 +210,7 @@ sub run_tests {
 
     {
         local $BugId   = "20020124.005";
-        local $PatchId = "14795";
-        local $Message = "s///eg";
+        local $Message = "s///eg [change 13f46d054db22cf4]";
 
         for my $char ("a", "\x{df}", "\x{100}") {
             my $x = "$char b $char";
@@ -228,7 +231,7 @@ sub run_tests {
         my $num = 123;
         $num =~ /\d/;
         for (0 .. 1) {
-            my $match = ?? + 0;
+            my $match = m?? + 0;
             ok $match != $_, $Message, 
                 sprintf "'match one' %s on %s iteration" =>
                                $match ? 'succeeded' : 'failed',
@@ -256,11 +259,10 @@ sub run_tests {
     }
 
     {
-        local $PatchId = '18179';
         my $s = "\x{100}" x 5;
         my $ok = $s =~ /(\x{100}{4})/;
         my ($ord, $len) = (ord $1, length $1);
-        ok $ok && $ord == 0x100 && $len == 4, "No panic: end_shift";
+        ok $ok && $ord == 0x100 && $len == 4, "No panic: end_shift [change 0e933229fa758625]";
     }
 
 
@@ -461,19 +463,8 @@ sub run_tests {
         func "standalone";
         $_ = "x"; s/x/func "in subst"/e;
         $_ = "x"; s/x/func "in multiline subst"/em;
-
-        #
-        # Next two give 'panic: malloc'.
-        # Outcommented, using two TODOs.
-        #
-        local $TODO    = 'panic: malloc';
-        local $Message = 'Postponed regexp and propaged modifier';
-      # ok 0 for 1 .. 2;
-      SKIP: {
-            skip "panic: malloc", 2;
-            $_ = "x"; /x(?{func "in regexp"})/;
-            $_ = "x"; /x(?{func "in multiline regexp"})/m;
-        }
+        $_ = "x"; /x(?{func "in regexp"})/;
+        $_ = "x"; /x(?{func "in multiline regexp"})/m;
     }
 
 
@@ -596,18 +587,17 @@ sub run_tests {
 
 
     {
-        local $PatchId = '26410';
         {
             package wooosh;
             sub gloople {"!"}
         }
         my $aeek = bless {} => 'wooosh';
         eval_ok sub {$aeek -> gloople () =~ /(.)/g},
-               "//g match against return value of sub";
+               "//g match against return value of sub [change e26a497577f3ce7b]";
 
         sub gloople {"!"}
         eval_ok sub {gloople () =~ /(.)/g},
-               "26410 didn't affect sub calls for some reason";
+               "change e26a497577f3ce7b didn't affect sub calls for some reason";
     }
 
 
@@ -939,7 +929,7 @@ sub run_tests {
         my @words = ('word1', 'word3', 'word5');
         my $count;
         foreach my $word (@words) {
-            $text =~ s/$word\s//gi; # Leave a space to seperate words
+            $text =~ s/$word\s//gi; # Leave a space to separate words
                                     # in the resultant str.
             # The following block is not working.
             if ($&) {
@@ -1053,15 +1043,6 @@ sub run_tests {
         iseq $te [0], '../';
     }
 
-       # This currently has to come before any "use encoding" in this file.
-    {
-        local $Message;
-        local $BugId   = '59342';
-        must_warn 'qr/\400/', '^Use of octal value above 377';
-    }
-
-
-
     {
         local $BugId =  '60034';
         my $a = "xyzt" x 8192;
@@ -1190,6 +1171,50 @@ sub run_tests {
 
         iseq($first, $second);
     }    
+
+    {
+       local $BugId = 70998;
+       local $Message
+        = 'utf8 =~ /trie/ where trie matches a continuation octet';
+
+       # Catch warnings:
+       my $w;
+       local $SIG{__WARN__} = sub { $w .= shift };
+
+       # This bug can be reduced to
+       qq{\x{30ab}} =~ /\xab|\xa9/;
+       # but it's nice to have a more 'real-world' test. The original test
+       # case from the RT ticket follows:
+
+       my %conv = (
+                   "\xab"     => "<",
+                   "\xa9"     => "(c)",
+                  );
+       my $conv_rx = '(' . join('|', map { quotemeta } keys %conv) . ')';
+       $conv_rx = qr{$conv_rx};
+
+       my $x
+        = qq{\x{3042}\x{304b}\x{3055}\x{305f}\x{306a}\x{306f}\x{307e}}
+        . qq{\x{3084}\x{3089}\x{308f}\x{3093}\x{3042}\x{304b}\x{3055}}
+        . qq{\x{305f}\x{306a}\x{306f}\x{307e}\x{3084}\x{3089}\x{308f}}
+        . qq{\x{3093}\x{30a2}\x{30ab}\x{30b5}\x{30bf}\x{30ca}\x{30cf}}
+        . qq{\x{30de}\x{30e4}\x{30e9}\x{30ef}\x{30f3}\x{30a2}\x{30ab}}
+        . qq{\x{30b5}\x{30bf}\x{30ca}\x{30cf}\x{30de}\x{30e4}\x{30e9}}
+        . qq{\x{30ef}\x{30f3}\x{30a2}\x{30ab}\x{30b5}\x{30bf}\x{30ca}}
+        . qq{\x{30cf}\x{30de}\x{30e4}\x{30e9}\x{30ef}\x{30f3}};
+
+       $x =~ s{$conv_rx}{$conv{$1}}eg;
+
+       iseq($w,undef);
+    }
+
+    {
+        local $BugId = 68564;   # minimal CURLYM limited to 32767 matches
+        local $Message = "stclass optimisation does not break + inside (?=)";
+        iseq join("-", "   abc   def  " =~ /(?=(\S+))/g),
+             "abc-bc-c-def-ef-f",
+    }
+
 } # End of sub run_tests
 
 1;