Test perl #4289

[perl5.git] / t / re / pat_rt_report.t

diff --git a/t/re/pat_rt_report.t b/t/re/pat_rt_report.t
index 18005e6..d19d1df 100644 (file)
--- a/t/re/pat_rt_report.t
+++ b/t/re/pat_rt_report.t
@@ -7,7 +7,7 @@
 use strict;
 use warnings;
 use 5.010;
-
+use Config;
 
 sub run_tests;
 
@@ -15,17 +15,14 @@ $| = 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 $@;
+    require './test.pl';
+    skip_all_if_miniperl("miniperl can't load Tie::Hash::NamedCapture, need for %+ and %-");
 }
 
 
-plan tests => 2514;  # Update this when adding/deleting tests.
+plan tests => 2530;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -387,14 +384,7 @@ sub run_tests {
         is("@_", "a|b|c", $message);
     }
 
-    {
-        # XXX DAPM 13-Apr-06. Recursive split is still broken. It's only luck it
-        # hasn't been crashing. Disable this test until it is fixed properly.
-        # XXX also check what it returns rather than just doing ok(1,...)
-        # split /(?{ split "" })/, "abc";
-        local $::TODO = "Recursive split is still broken";
-        ok 0, 'cache_re & "(?{": it dumps core in 5.6.1 & 5.8.0';
-    }
+    is(join('-', split /(?{ split "" })/, "abc"), 'a-b-c', 'nested split');
 
     {
         $_ = "code:   'x' { '...' }\n"; study;
@@ -537,7 +527,8 @@ sub run_tests {
     }
 
     {
-        local $::TODO = "See changes 26925-26928, which reverted change 26410";
+        # [perl #78680]
+        # See changes 26925-26928, which reverted change 26410
         {
             package lv;
             our $var = "abc";
@@ -555,7 +546,6 @@ sub run_tests {
             is($f, "ab", "pos() retained between calls");
         }
         else {
-            local $::TODO;
             ok 0, "Code failed: $@";
         }
 
@@ -572,7 +562,6 @@ sub run_tests {
             is($g, "ab", "pos() retained between calls");
         }
         else {
-            local $::TODO;
             ok 0, "Code failed: $@";
         }
     }
@@ -932,6 +921,10 @@ sub run_tests {
          $_ = "CCCCBAA";
          ok(s/(*:X)A+|(*:Y)B+|(*:Z)C+/$REGMARK/g, $message);
          is($_, "ZYX", $message);
+         # Use a longer name to force reallocation of $REGMARK.
+         $_ = "CCCCBAA";
+         ok(s/(*:X)A+|(*:YYYYYYYYYYYYYYYY)B+|(*:Z)C+/$REGMARK/g, $message);
+         is($_, "ZYYYYYYYYYYYYYYYYX", $message);
     }
 
     {
@@ -1101,6 +1094,68 @@ sub run_tests {
           'stclass optimisation does not break + inside (?=); Bug 68564');
     }
 
+    {
+        use charnames ":full";
+        # Delayed interpolation of \N'
+        my $r1 = qr/\N{THAI CHARACTER SARA I}/;
+        my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}";
+
+        # Bug #56444
+        ok $s1 =~ /$r1+/, 'my $r1 = qr/\N{THAI CHARACTER SARA I}/; my $s1 = "\x{E34}\x{E34}\x{E34}\x{E34}; $s1 =~ /$r1+/';
+
+        # Bug #62056
+        ok "${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/, '"${s1}A" =~ m/$s1\N{LATIN CAPITAL LETTER A}/';
+
+        ok "abbbbc" =~ m/\N{1}/ && $& eq "a", '"abbbbc" =~ m/\N{1}/ && $& eq "a"';
+        ok "abbbbc" =~ m/\N{3,4}/ && $& eq "abbb", '"abbbbc" =~ m/\N{3,4}/ && $& eq "abbb"';
+    }
+
+    {
+        use charnames ":full";
+        my $message = '[perl #74982] Period coming after \N{}';
+        ok("\x{ff08}." =~ m/\N{FULLWIDTH LEFT PARENTHESIS}./ && $& eq "\x{ff08}.", $message);
+        ok("\x{ff08}." =~ m/[\N{FULLWIDTH LEFT PARENTHESIS}]./ && $& eq "\x{ff08}.", $message);
+    }
+
+SKIP: {
+    ######## "Segfault using HTML::Entities", Richard Jolly <richardjolly@mac.com>, <A3C7D27E-C9F4-11D8-B294-003065AE00B6@mac.com> in perl-unicode@perl.org
+
+    skip('Perl configured without Encode module', 1)
+       unless $Config{extensions} =~ / Encode /;
+
+    # Test case cut down by jhi
+    fresh_perl_like(<<'EOP', qr!Malformed UTF-8 character \(unexpected end of string\) in substitution \(s///\) at!, 'Segfault using HTML::Entities');
+use Encode;
+my $t = ord('A') == 193 ? "\xEA" : "\xE9";
+Encode::_utf8_on($t);
+$t =~ s/([^a])//ge;
+EOP
+    }
+
+    {
+        # pattern must be compiled late or we can break the test file
+        my $message = '[perl #115050] repeated nothings in a trie can cause panic';
+        my $pattern;
+        $pattern = '[xyz]|||';
+        ok("blah blah" =~ /$pattern/, $message);
+        ok("blah blah" =~ /(?:$pattern)h/, $message);
+        $pattern = '|||[xyz]';
+        ok("blah blah" =~ /$pattern/, $message);
+        ok("blah blah" =~ /(?:$pattern)h/, $message);
+    }
+
+    {
+        # [perl #4289] First mention $& after a match
+        fresh_perl_is(
+            '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$&|, "\n"',
+            "b\n", {}, '$& first mentioned after match');
+        fresh_perl_is(
+            '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$`|, "\n"',
+            "a\n", {}, '$` first mentioned after match');
+        fresh_perl_is(
+            '$_ = "abc"; /b/g; $_ = "hello"; print eval q|$\'|,"\n"',
+            "c\n", {}, '$\' first mentioned after match');
+    }
 } # End of sub run_tests
 
 1;