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_advanced.t
index 811a04b..58966e7 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 => 1185;  # Update this when adding/deleting tests.
+plan tests => 1343;  # Update this when adding/deleting tests.
 
 run_tests() unless caller;
 
@@ -123,7 +127,7 @@ sub run_tests {
             ok s/(\d+)\s*([\w\-]+)/$1 . uc $2/e;
             ok my ($latin) = /^(.+)(?:\s+\d)/;
             iseq $latin, "stra\337e";
-           ok $latin =~ s/stra\337e/straße/;
+        ok $latin =~ s/stra\337e/straße/;
             #
             # Previous code follows, but outcommented - there were no tests.
             #
@@ -454,7 +458,7 @@ sub run_tests {
 
         my $lower = "\N{LATIN SMALL LETTER A WITH GRAVE}";
         my $UPPER = "\N{LATIN CAPITAL LETTER A WITH GRAVE}";
-        
+
         ok $lower =~ m/$UPPER/i;
         ok $UPPER =~ m/$lower/i;
         ok $lower =~ m/[$UPPER]/i;
@@ -484,14 +488,14 @@ sub run_tests {
 
     {
         use charnames ':full';
-        local $PatchId = "13843";
         local $Message = "GREEK CAPITAL LETTER SIGMA vs " .
                          "COMBINING GREEK PERISPOMENI";
 
         my $SIGMA = "\N{GREEK CAPITAL LETTER SIGMA}";
         my $char  = "\N{COMBINING GREEK PERISPOMENI}";
 
-        may_not_warn sub {ok "_:$char:_" !~ m/_:$SIGMA:_/i};
+        may_not_warn sub {ok "_:$char:_" !~ m/_:$SIGMA:_/i},
+           'Did not warn [change a5961de5f4215b5c]';
     }
 
 
@@ -533,7 +537,7 @@ sub run_tests {
         ok $sigma =~ /$SIGMA/i;
         ok $sigma =~ /$Sigma/i;
         ok $sigma =~ /$sigma/i;
-        
+
         ok $SIGMA =~ /[$SIGMA]/i;
         ok $SIGMA =~ /[$Sigma]/i;
         ok $SIGMA =~ /[$sigma]/i;
@@ -641,7 +645,7 @@ sub run_tests {
 
         ok "\N{LATIN SMALL LETTER SHARP S}" =~ /ss/i;
         ok "\N{LATIN SMALL LETTER SHARP S}" =~ /SS/i;
+
         local $Message = "Unoptimized named sequence in class";
         ok "ss" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i;
         ok "SS" =~ /[\N{LATIN SMALL LETTER SHARP S}x]/i;
@@ -720,13 +724,13 @@ sub run_tests {
         my $t1 = "Q003\n\n\x{e4}\x{f6}\n\nQ004\n\n\x{e7}";
         my $r1 = "";
         while ($t1 =~ / \G ( .+? ) \n\s+ ( .+? ) ( $ | \n\s+ ) /xgcs) {
-           $r1 .= $1 . $2;
+        $r1 .= $1 . $2;
         }
 
         my $t2 = $t1 . "\x{100}"; # Repeat with a larger char
         my $r2 = "";
         while ($t2 =~ / \G ( .+? ) \n\s+ ( .+? ) ( $ | \n\s+ ) /xgcs) {
-           $r2 .= $1 . $2;
+        $r2 .= $1 . $2;
         }
         $r2 =~ s/\x{100}//;
 
@@ -768,7 +772,7 @@ sub run_tests {
         local $Message = "No SEGV in s/// and UTF-8";
         my $s = "s#\x{100}" x 4;
         ok $s =~ s/[^\w]/ /g;
-        if ( $ENV{PERL_TEST_LEGACY_POSIX_CC} ) {
+        if ( 1 or $ENV{PERL_TEST_LEGACY_POSIX_CC} ) {
             iseq $s, "s \x{100}" x 4;
         }
         else {
@@ -836,7 +840,7 @@ sub run_tests {
 
 
 
-    
+
     {
         local $\;
         $_ = 'aaaaaaaaaa';
@@ -858,7 +862,7 @@ sub run_tests {
         # To: perl-unicode@perl.org
 
         local $Message = 'Markus Kuhn 2003-02-26';
-    
+
         my $x = "\x{2019}\nk";
         ok $x =~ s/(\S)\n(\S)/$1 $2/sg;
         ok $x eq "\x{2019} k";
@@ -900,6 +904,9 @@ sub run_tests {
         my $re = qq /^([^X]*)X/;
         utf8::upgrade ($re);
         ok "\x{100}X" =~ /$re/, "S_cl_and ANYOF_UNICODE & ANYOF_INVERTED";
+        my $loc_re = qq /(?l:^([^X]*)X)/;
+        utf8::upgrade ($loc_re);
+        ok "\x{100}X" =~ /$loc_re/, "locale, S_cl_and ANYOF_UNICODE & ANYOF_INVERTED";
     }
 
     {
@@ -943,7 +950,7 @@ sub run_tests {
     {   # TRIE related
         our @got = ();
         "words" =~ /(word|word|word)(?{push @got, $1})s$/;
-        iseq @got, 1, "TRIE optimation";
+        iseq @got, 1, "TRIE optimisation";
 
         @got = ();
         "words" =~ /(word|word|word)(?{push @got,$1})s$/i;
@@ -1018,27 +1025,26 @@ sub run_tests {
 
 
     {
-       BEGIN {
-           unshift @INC, 'lib';
-       }
+    BEGIN {
+        unshift @INC, 'lib';
+    }
         use Cname;
-        
+
         ok 'fooB'  =~ /\N{foo}[\N{B}\N{b}]/, "Passthrough charname";
-        my $test   = 1233;
         #
         # Why doesn't must_warn work here?
         #
         my $w;
         local $SIG {__WARN__} = sub {$w .= "@_"};
         eval 'q(xxWxx) =~ /[\N{WARN}]/';
-        ok $w && $w =~ /^Ignoring excess chars from/,
-                 "Ignoring excess chars warning";
+        ok $w && $w =~ /Using just the first character returned by \\N{} in character class/,
+                 "single character in [\\N{}] warning";
 
         undef $w;
         eval q [ok "\0" !~ /[\N{EMPTY-STR}XY]/,
                    "Zerolength charname in charclass doesn't match \\0"];
-        ok $w && $w =~ /^Ignoring zero length/,
-                 'Ignoring zero length \N{%} in character class warning';
+        ok $w && $w =~ /Ignoring zero length/,
+                 'Ignoring zero length \N{} in character class warning';
 
         ok 'AB'  =~ /(\N{EVIL})/ && $1 eq 'A', 'Charname caching $1';
         ok 'ABC' =~ /(\N{EVIL})/,              'Charname caching $1';
@@ -1046,7 +1052,41 @@ sub run_tests {
                     'Empty string charname produces NOTHING node';
         ok ''    =~ /\N{EMPTY-STR}/,
                     'Empty string charname produces NOTHING node';
-            
+        ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/, 'Verify that long string works';
+        ok "\N{LONG-STR}" =~ /^\N{LONG-STR}$/i, 'Verify under folding that long string works';
+
+        # If remove the limitation in regcomp code these should work
+        # differently
+        undef $w;
+        eval q [ok "\N{LONG-STR}" =~ /^\N{TOO-LONG-STR}$/, 'Verify that too long a string fails gracefully'];
+        ok $w && $w =~ /Using just the first characters returned/, 'Verify that got too-long string warning in \N{} that exceeds the limit';
+        undef $w;
+        eval q [ok "\N{LONG-STR}" =~ /^\N{TOO-LONG-STR}$/i, 'Verify under folding that too long a string fails gracefully'];
+        ok $w && $w =~ /Using just the first characters returned/, 'Verify under folding that got too-long string warning in \N{} that exceeds the limit';
+        undef $w;
+        eval q [ok "\N{TOO-LONG-STR}" !~ /^\N{TOO-LONG-STR}$/, 'Verify that too long a string doesnt work'];
+        ok $w && $w =~ /Using just the first characters returned/, 'Verify that got too-long string warning in \N{} that exceeds the limit';
+        undef $w;
+        eval q [ok "\N{TOO-LONG-STR}" !~ /^\N{TOO-LONG-STR}$/i, 'Verify under folding that too long a string doesnt work'];
+        ok $w && $w =~ /Using just the first characters returned/i, 'Verify under folding that got too-long string warning in \N{} that exceeds the limit';
+        undef $w;
+        eval 'q(syntax error) =~ /\N{MALFORMED}/';
+        ok $@ && $@ =~ /Malformed/, 'Verify that malformed utf8 gives an error';
+        undef $w;
+        eval 'q() =~ /\N{4F}/';
+        ok $w && $w =~ /Deprecated/, 'Verify that leading digit in name gives warning';
+        undef $w;
+        eval 'q() =~ /\N{COM,MA}/';
+        ok $w && $w =~ /Deprecated/, 'Verify that comma in name gives warning';
+        undef $w;
+        my $name = "A\x{D7}O";
+        eval "q(W) =~ /\\N{$name}/";
+        ok $w && $w =~ /Deprecated/, 'Verify that latin1 symbol in name gives warning';
+        undef $w;
+        $name = "A\x{D1}O";
+        eval "q(W) =~ /\\N{$name}/";
+        ok ! $w, 'Verify that latin1 letter in name doesnt give warning';
+
     }
 
 
@@ -1063,7 +1103,8 @@ sub run_tests {
             'Intermixed named and unicode escapes';
         ok "\N{SPACE}\N{U+0041}\N{SPACE}\N{U+0042}" =~
            /[\N{SPACE}\N{U+0041}][\N{SPACE}\N{U+0042}]/,
-            'Intermixed named and unicode escapes';     
+            'Intermixed named and unicode escapes';
+        ok "\0" =~ /^\N{NULL}$/, 'Verify that \N{NULL} works; is not confused with an error';
     }
 
 
@@ -1110,7 +1151,7 @@ sub run_tests {
         ok $s eq '123456', 'Named capture (angle brackets) s///';
         $s = '123453456';
         $s =~ s/(?'digits'\d+)\k'digits'/$+{digits}/;
-        ok $s eq '123456', 'Named capture (single quotes) s///';    
+        ok $s eq '123456', 'Named capture (single quotes) s///';
     }
 
 
@@ -1120,7 +1161,6 @@ sub run_tests {
             '_'.pack('U', 0x00F1),        # _ + n-tilde
             'c'.pack('U', 0x0327),        # c + cedilla
             pack('U*', 0x00F1, 0x0327),   # n-tilde + cedilla
-            'a'.pack('U', 0x00B2),        # a + superscript two
             pack('U', 0x0391),            # ALPHA
             pack('U', 0x0391).'2',        # ALPHA + 2
             pack('U', 0x0391).'_',        # ALPHA + _
@@ -1271,7 +1311,7 @@ sub run_tests {
         for my $name ('', ':foo') {
             for my $pat ("(*PRUNE$name)",
                          ($name ? "(*MARK$name)" : "") . "(*SKIP$name)",
-                         "(*COMMIT$name)") {                         
+                         "(*COMMIT$name)") {
                 for my $suffix ('(*FAIL)', '') {
                     'aaaab' =~ /a+b$pat$suffix/;
                     iseq $REGERROR,
@@ -1290,7 +1330,7 @@ sub run_tests {
         for my $name ('', ':foo') {
             for my $pat ("(*PRUNE$name)",
                          ($name ? "(*MARK$name)" : "") . "(*SKIP$name)",
-                         "(*COMMIT$name)") {                         
+                         "(*COMMIT$name)") {
                 for my $suffix ('(*FAIL)','') {
                     'aaaab' =~ /a+b$pat$suffix/;
                   ::iseq $REGERROR,
@@ -1298,8 +1338,8 @@ sub run_tests {
                         "Test $pat and \$REGERROR $suffix";
                 }
             }
-        }      
-    }    
+        }
+    }
 
 
     {
@@ -1311,7 +1351,7 @@ sub run_tests {
             "aaaaa$word" =~
               /a+(?:bar(*COMMIT:bar)|baz(*COMMIT:baz)|bop(*COMMIT:bop))(*FAIL)/;
             iseq $REGERROR, $word;
-        }    
+        }
     }
 
     {
@@ -1374,14 +1414,14 @@ sub run_tests {
         ok "foobarbarxyz" =~ qr/(foo)(bar)\g{-1}xyz/;
         ok "foobarbarxyz" =~ qr/(foo${qr_barR1})xyz/;
         ok "foobarbarxyz" =~ qr/(foo(bar)\g{-1})xyz/;
-    } 
+    }
 
     {
         local $Message = '$REGMARK';
         our @r = ();
         our ($REGMARK, $REGERROR);
         ok 'foofoo' =~ /foo (*MARK:foo) (?{push @r,$REGMARK}) /x;
-        iseq "@r","foo";           
+        iseq "@r","foo";
         iseq $REGMARK, "foo";
         ok 'foofoo' !~ /foo (*MARK:foo) (*FAIL) /x;
         ok !$REGMARK;
@@ -1395,11 +1435,11 @@ sub run_tests {
         $x = "abc.def.ghi.jkl";
         $x =~ s/.*\K\..*//;
         iseq $x, "abc.def.ghi";
-        
+
         $x = "one two three four";
         $x =~ s/o+ \Kthree//g;
         iseq $x, "one two  four";
-        
+
         $x = "abcde";
         $x =~ s/(.)\K/$1/g;
         iseq $x, "aabbccddee";
@@ -1432,11 +1472,57 @@ sub run_tests {
         ok "\N{ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "I =~ ID_Continue";
         ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Alphabetic}/, "i =~ Alphabetic";
         ok "\N{SMALL ROMAN NUMERAL ONE}" !~ /\p{Uppercase}/,  "i !~ Uppercase";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Uppercase}/i,  "i =~ Uppercase under /i";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" !~ /\p{Titlecase}/,  "i !~ Titlecase";
+        ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Titlecase}/i,  "i =~ Titlecase under /i";
+        ok "\N{ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/i,  "I =~ Lowercase under
+        /i";
         ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{Lowercase}/,  "i =~ Lowercase";
         ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDStart}/,    "i =~ ID_Start";
         ok "\N{SMALL ROMAN NUMERAL ONE}" =~ /\p{IDContinue}/, "i =~ ID_Continue"
     }
 
+    {   # More checking that /i works on the few properties that it makes a
+        # difference.  Uppercase, Lowercase, and Titlecase were done in the
+        # block above
+        ok "A" =~ /\p{PosixUpper}/,  "A =~ PosixUpper";
+        ok "A" =~ /\p{PosixUpper}/i,  "A =~ PosixUpper under /i";
+        ok "A" !~ /\p{PosixLower}/,  "A !~ PosixLower";
+        ok "A" =~ /\p{PosixLower}/i,  "A =~ PosixLower under /i";
+        ok "a" !~ /\p{PosixUpper}/,  "a !~ PosixUpper";
+        ok "a" =~ /\p{PosixUpper}/i,  "a =~ PosixUpper under /i";
+        ok "a" =~ /\p{PosixLower}/,  "a =~ PosixLower";
+        ok "a" =~ /\p{PosixLower}/i,  "a =~ PosixLower under /i";
+
+        ok "\xC0" =~ /\p{XPosixUpper}/,  "\\xC0 =~ XPosixUpper";
+        ok "\xC0" =~ /\p{XPosixUpper}/i,  "\\xC0 =~ XPosixUpper under /i";
+        ok "\xC0" !~ /\p{XPosixLower}/,  "\\xC0 !~ XPosixLower";
+        ok "\xC0" =~ /\p{XPosixLower}/i,  "\\xC0 =~ XPosixLower under /i";
+        ok "\xE0" !~ /\p{XPosixUpper}/,  "\\xE0 !~ XPosixUpper";
+        ok "\xE0" =~ /\p{XPosixUpper}/i,  "\\xE0 =~ XPosixUpper under /i";
+        ok "\xE0" =~ /\p{XPosixLower}/,  "\\xE0 =~ XPosixLower";
+        ok "\xE0" =~ /\p{XPosixLower}/i,  "\\xE0 =~ XPosixLower under /i";
+
+        ok "\xC0" =~ /\p{UppercaseLetter}/,  "\\xC0 =~ UppercaseLetter";
+        ok "\xC0" =~ /\p{UppercaseLetter}/i,  "\\xC0 =~ UppercaseLetter under /i";
+        ok "\xC0" !~ /\p{LowercaseLetter}/,  "\\xC0 !~ LowercaseLetter";
+        ok "\xC0" =~ /\p{LowercaseLetter}/i,  "\\xC0 =~ LowercaseLetter under /i";
+        ok "\xC0" !~ /\p{TitlecaseLetter}/,  "\\xC0 !~ TitlecaseLetter";
+        ok "\xC0" =~ /\p{TitlecaseLetter}/i,  "\\xC0 =~ TitlecaseLetter under /i";
+        ok "\xE0" !~ /\p{UppercaseLetter}/,  "\\xE0 !~ UppercaseLetter";
+        ok "\xE0" =~ /\p{UppercaseLetter}/i,  "\\xE0 =~ UppercaseLetter under /i";
+        ok "\xE0" =~ /\p{LowercaseLetter}/,  "\\xE0 =~ LowercaseLetter";
+        ok "\xE0" =~ /\p{LowercaseLetter}/i,  "\\xE0 =~ LowercaseLetter under /i";
+        ok "\xE0" !~ /\p{TitlecaseLetter}/,  "\\xE0 !~ TitlecaseLetter";
+        ok "\xE0" =~ /\p{TitlecaseLetter}/i,  "\\xE0 =~ TitlecaseLetter under /i";
+        ok "\x{1C5}" !~ /\p{UppercaseLetter}/,  "\\x{1C5} !~ UppercaseLetter";
+        ok "\x{1C5}" =~ /\p{UppercaseLetter}/i,  "\\x{1C5} =~ UppercaseLetter under /i";
+        ok "\x{1C5}" !~ /\p{LowercaseLetter}/,  "\\x{1C5} !~ LowercaseLetter";
+        ok "\x{1C5}" =~ /\p{LowercaseLetter}/i,  "\\x{1C5} =~ LowercaseLetter under /i";
+        ok "\x{1C5}" =~ /\p{TitlecaseLetter}/,  "\\x{1C5} =~ TitlecaseLetter";
+        ok "\x{1C5}" =~ /\p{TitlecaseLetter}/i,  "\\x{1C5} =~ TitlecaseLetter under /i";
+    }
+
 
     {
         # requirement of Unicode Technical Standard #18, 1.7 Code Points
@@ -1458,7 +1544,7 @@ sub run_tests {
         }
         iseq $res, "1",
             "Check that (?|...) doesnt cause dupe entries in the names array";
-        
+
         $res = "";
         if ('11' =~ /(?|(?<digit>1)|(?<digit>2))(?&digit)/) {
             $res = "@{$- {digit}}";
@@ -1473,10 +1559,10 @@ sub run_tests {
         local $Message = "ASCII pattern that really is UTF-8";
         my @w;
         local $SIG {__WARN__} = sub {push @w, "@_"};
-        my $c = qq (\x{DF}); 
+        my $c = qq (\x{DF});
         ok $c =~ /${c}|\x{100}/;
         ok @w == 0;
-    }    
+    }
 
 
     {
@@ -1486,7 +1572,7 @@ sub run_tests {
         iseq "$1$2", "foobar";
         {
             'foooooobaaaaar' =~ /$qr/;
-            iseq "$1$2", 'foooooobaaaaar';    
+            iseq "$1$2", 'foooooobaaaaar';
         }
         iseq "$1$2", "foobar";
     }
@@ -1503,7 +1589,7 @@ sub run_tests {
         s/\H/H/g;
         s/\h/h/g;
         iseq $_, "hhHHhHhhHH";
-    }    
+    }
 
 
     {
@@ -1650,7 +1736,7 @@ sub run_tests {
     {
         local $_;
         ($_ = 'abc') =~ /(abc)/g;
-        $_ = '123'; 
+        $_ = '123';
         iseq "$1", 'abc', "/g leads to unsafe match vars: $1";
     }
 
@@ -1678,12 +1764,12 @@ sub run_tests {
 
     {
 # more TRIE/AHOCORASICK problems with mixed utf8 / latin-1 and case folding
-       for my $chr (160 .. 255) {
-           my $chr_byte = chr($chr);
-           my $chr_utf8 = chr($chr); utf8::upgrade($chr_utf8);
-           my $rx = qr{$chr_byte|X}i;
-           ok($chr_utf8 =~ $rx, "utf8/latin, codepoint $chr");
-       }
+    for my $chr (160 .. 255) {
+        my $chr_byte = chr($chr);
+        my $chr_utf8 = chr($chr); utf8::upgrade($chr_utf8);
+        my $rx = qr{$chr_byte|X}i;
+        ok($chr_utf8 =~ $rx, "utf8/latin, codepoint $chr");
+    }
     }
 
     {
@@ -1718,23 +1804,23 @@ sub run_tests {
 
     SKIP: {
         # XXX: This set of tests is essentially broken, POSIX character classes
-        # should not have differing definitions under Unicode. 
+        # should not have differing definitions under Unicode.
         # There are property names for that.
         skip "Tests assume ASCII", 4 unless $IS_ASCII;
 
         my @notIsPunct = grep {/[[:punct:]]/ and not /\p{IsPunct}/}
                                 map {chr} 0x20 .. 0x7f;
         iseq join ('', @notIsPunct), '$+<=>^`|~',
-            '[:punct:] disagress with IsPunct on Symbols';
+            '[:punct:] disagrees with IsPunct on Symbols';
 
         my @isPrint = grep {not /[[:print:]]/ and /\p{IsPrint}/}
                             map {chr} 0 .. 0x1f, 0x7f .. 0x9f;
-        iseq join ('', @isPrint), "\x09\x0a\x0b\x0c\x0d\x85",
-            'IsPrint disagrees with [:print:] on control characters';
+        iseq join ('', @isPrint), "",
+            'IsPrint agrees with [:print:] on control characters';
 
         my @isPunct = grep {/[[:punct:]]/ != /\p{IsPunct}/}
                             map {chr} 0x80 .. 0xff;
-        iseq join ('', @isPunct), "\xa1\xab\xb7\xbb\xbf",      # ¡ « · » ¿
+        iseq join ('', @isPunct), "\xa1\xab\xb7\xbb\xbf",    # ¡ « · » ¿
             'IsPunct disagrees with [:punct:] outside ASCII';
 
         my @isPunctLatin1 = eval q {
@@ -1744,9 +1830,310 @@ sub run_tests {
         skip "Eval failed ($@)", 1 if $@;
         skip "PERL_LEGACY_UNICODE_CHARCLASS_MAPPINGS set to 0", 1
               if !$ENV{PERL_TEST_LEGACY_POSIX_CC};
-        iseq join ('', @isPunctLatin1), '', 
+        iseq join ('', @isPunctLatin1), '',
             'IsPunct agrees with [:punct:] with explicit Latin1';
-    } 
+    }
+
+
+    {
+       # Tests for [#perl 71942]
+        our $count_a;
+        our $count_b;
+
+        my $c = 0;
+        for my $re (
+#            [
+#                should match?,
+#                input string,
+#                re 1,
+#                re 2,
+#                expected values of count_a and count_b,
+#            ]
+            [
+                0,
+                "xababz",
+                qr/a+(?{$count_a++})b?(*COMMIT)(*FAIL)/,
+                qr/a+(?{$count_b++})b?(*COMMIT)z/,
+                1,
+            ],
+            [
+                0,
+                "xababz",
+                qr/a+(?{$count_a++})b?(*COMMIT)\s*(*FAIL)/,
+                qr/a+(?{$count_b++})b?(*COMMIT)\s*z/,
+                1,
+            ],
+            [
+                0,
+                "xababz",
+                qr/a+(?{$count_a++})(?:b|)?(*COMMIT)(*FAIL)/,
+                qr/a+(?{$count_b++})(?:b|)?(*COMMIT)z/,
+                1,
+            ],
+            [
+                0,
+                "xababz",
+                qr/a+(?{$count_a++})b{0,6}(*COMMIT)(*FAIL)/,
+                qr/a+(?{$count_b++})b{0,6}(*COMMIT)z/,
+                1,
+            ],
+            [
+                0,
+                "xabcabcz",
+                qr/a+(?{$count_a++})(bc){0,6}(*COMMIT)(*FAIL)/,
+                qr/a+(?{$count_b++})(bc){0,6}(*COMMIT)z/,
+                1,
+            ],
+            [
+                0,
+                "xabcabcz",
+                qr/a+(?{$count_a++})(bc*){0,6}(*COMMIT)(*FAIL)/,
+                qr/a+(?{$count_b++})(bc*){0,6}(*COMMIT)z/,
+                1,
+            ],
+
+
+            [
+                0,
+                "aaaabtz",
+                qr/a+(?{$count_a++})b?(*PRUNE)(*FAIL)/,
+                qr/a+(?{$count_b++})b?(*PRUNE)z/,
+                4,
+            ],
+            [
+                0,
+                "aaaabtz",
+                qr/a+(?{$count_a++})b?(*PRUNE)\s*(*FAIL)/,
+                qr/a+(?{$count_b++})b?(*PRUNE)\s*z/,
+                4,
+            ],
+            [
+                0,
+                "aaaabtz",
+                qr/a+(?{$count_a++})(?:b|)(*PRUNE)(*FAIL)/,
+                qr/a+(?{$count_b++})(?:b|)(*PRUNE)z/,
+                4,
+            ],
+            [
+                0,
+                "aaaabtz",
+                qr/a+(?{$count_a++})b{0,6}(*PRUNE)(*FAIL)/,
+                qr/a+(?{$count_b++})b{0,6}(*PRUNE)z/,
+                4,
+            ],
+            [
+                0,
+                "aaaabctz",
+                qr/a+(?{$count_a++})(bc){0,6}(*PRUNE)(*FAIL)/,
+                qr/a+(?{$count_b++})(bc){0,6}(*PRUNE)z/,
+                4,
+            ],
+            [
+                0,
+                "aaaabctz",
+                qr/a+(?{$count_a++})(bc*){0,6}(*PRUNE)(*FAIL)/,
+                qr/a+(?{$count_b++})(bc*){0,6}(*PRUNE)z/,
+                4,
+            ],
+
+            [
+                0,
+                "aaabaaab",
+                qr/a+(?{$count_a++;})b?(*SKIP)(*FAIL)/,
+                qr/a+(?{$count_b++;})b?(*SKIP)z/,
+                2,
+            ],
+            [
+                0,
+                "aaabaaab",
+                qr/a+(?{$count_a++;})b?(*SKIP)\s*(*FAIL)/,
+                qr/a+(?{$count_b++;})b?(*SKIP)\s*z/,
+                2,
+            ],
+            [
+                0,
+                "aaabaaab",
+                qr/a+(?{$count_a++;})(?:b|)(*SKIP)(*FAIL)/,
+                qr/a+(?{$count_b++;})(?:b|)(*SKIP)z/,
+                2,
+            ],
+            [
+                0,
+                "aaabaaab",
+                qr/a+(?{$count_a++;})b{0,6}(*SKIP)(*FAIL)/,
+                qr/a+(?{$count_b++;})b{0,6}(*SKIP)z/,
+                2,
+            ],
+            [
+                0,
+                "aaabcaaabc",
+                qr/a+(?{$count_a++;})(bc){0,6}(*SKIP)(*FAIL)/,
+                qr/a+(?{$count_b++;})(bc){0,6}(*SKIP)z/,
+                2,
+            ],
+            [
+                0,
+                "aaabcaaabc",
+                qr/a+(?{$count_a++;})(bc*){0,6}(*SKIP)(*FAIL)/,
+                qr/a+(?{$count_b++;})(bc*){0,6}(*SKIP)z/,
+                2,
+            ],
+
+
+            [
+                0,
+                "aaddbdaabyzc",
+                qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? b?  (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? b?  (*SKIP:T1) z \s* c \1 /x,
+                4,
+            ],
+            [
+                0,
+                "aaddbdaabyzc",
+                qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? b?  (*SKIP:T1) \s* (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? b?  (*SKIP:T1) \s* z \s* c \1 /x,
+                4,
+            ],
+            [
+                0,
+                "aaddbdaabyzc",
+                qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? (?:b|)  (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? (?:b|)  (*SKIP:T1) z \s* c \1 /x,
+                4,
+            ],
+            [
+                0,
+                "aaddbdaabyzc",
+                qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? b{0,6}  (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? b{0,6}  (*SKIP:T1) z \s* c \1 /x,
+                4,
+            ],
+            [
+                0,
+                "aaddbcdaabcyzc",
+                qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? (bc){0,6}  (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? (bc){0,6}  (*SKIP:T1) z \s* c \1 /x,
+                4,
+            ],
+            [
+                0,
+                "aaddbcdaabcyzc",
+                qr/a (?{$count_a++;}) (*MARK:T1) (a*) .*? (bc*){0,6}  (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;}) (*MARK:T1) (a*) .*? (bc*){0,6}  (*SKIP:T1) z \s* c \1 /x,
+                4,
+            ],
+
+
+            [
+                0,
+                "aaaaddbdaabyzc",
+                qr/a (?{$count_a++;})  (a?) (*MARK:T1) (a*) .*? b?   (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;})  (a?) (*MARK:T1) (a*) .*? b?   (*MARK:T1) (*SKIP:T1) z \s* c \1 /x,
+                2,
+            ],
+            [
+                0,
+                "aaaaddbdaabyzc",
+                qr/a (?{$count_a++;})  (a?) (*MARK:T1) (a*) .*? b?   (*MARK:T1) (*SKIP:T1) \s* (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;})  (a?) (*MARK:T1) (a*) .*? b?   (*MARK:T1) (*SKIP:T1) \s* z \s* c \1 /x,
+                2,
+            ],
+            [
+                0,
+                "aaaaddbdaabyzc",
+                qr/a (?{$count_a++;})  (a?) (*MARK:T1) (a*) .*? (?:b|)   (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;})  (a?) (*MARK:T1) (a*) .*? (?:b|)   (*MARK:T1) (*SKIP:T1) z \s* c \1 /x,
+                2,
+            ],
+            [
+                0,
+                "aaaaddbdaabyzc",
+                qr/a (?{$count_a++;})  (a?) (*MARK:T1) (a*) .*? b{0,6}   (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;})  (a?) (*MARK:T1) (a*) .*? b{0,6}   (*MARK:T1) (*SKIP:T1) z \s* c \1 /x,
+                2,
+            ],
+            [
+                0,
+                "aaaaddbcdaabcyzc",
+                qr/a (?{$count_a++;})  (a?) (*MARK:T1) (a*) .*? (bc){0,6}   (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;})  (a?) (*MARK:T1) (a*) .*? (bc){0,6}   (*MARK:T1) (*SKIP:T1) z \s* c \1 /x,
+                2,
+            ],
+            [
+                0,
+                "aaaaddbcdaabcyzc",
+                qr/a (?{$count_a++;})  (a?) (*MARK:T1) (a*) .*? (bc*){0,6}   (*MARK:T1) (*SKIP:T1) (*FAIL) \s* c \1 /x,
+                qr/a (?{$count_b++;})  (a?) (*MARK:T1) (a*) .*? (bc*){0,6}   (*MARK:T1) (*SKIP:T1) z \s* c \1 /x,
+                2,
+            ],
+
+
+            [
+                0,
+                "AbcdCBefgBhiBqz",
+                qr/(A (.*)  (?{ $count_a++ }) C? (*THEN)  | A D) (*FAIL)/x,
+                qr/(A (.*)  (?{ $count_b++ }) C? (*THEN)  | A D) z/x,
+                1,
+            ],
+            [
+                0,
+                "AbcdCBefgBhiBqz",
+                qr/(A (.*)  (?{ $count_a++ }) C? (*THEN)  | A D) \s* (*FAIL)/x,
+                qr/(A (.*)  (?{ $count_b++ }) C? (*THEN)  | A D) \s* z/x,
+                1,
+            ],
+            [
+                0,
+                "AbcdCBefgBhiBqz",
+                qr/(A (.*)  (?{ $count_a++ }) (?:C|) (*THEN)  | A D) (*FAIL)/x,
+                qr/(A (.*)  (?{ $count_b++ }) (?:C|) (*THEN)  | A D) z/x,
+                1,
+            ],
+            [
+                0,
+                "AbcdCBefgBhiBqz",
+                qr/(A (.*)  (?{ $count_a++ }) C{0,6} (*THEN)  | A D) (*FAIL)/x,
+                qr/(A (.*)  (?{ $count_b++ }) C{0,6} (*THEN)  | A D) z/x,
+                1,
+            ],
+            [
+                0,
+                "AbcdCEBefgBhiBqz",
+                qr/(A (.*)  (?{ $count_a++ }) (CE){0,6} (*THEN)  | A D) (*FAIL)/x,
+                qr/(A (.*)  (?{ $count_b++ }) (CE){0,6} (*THEN)  | A D) z/x,
+                1,
+            ],
+            [
+                0,
+                "AbcdCBefgBhiBqz",
+                qr/(A (.*)  (?{ $count_a++ }) (CE*){0,6} (*THEN)  | A D) (*FAIL)/x,
+                qr/(A (.*)  (?{ $count_b++ }) (CE*){0,6} (*THEN)  | A D) z/x,
+                1,
+            ],
+        ) {
+            $c++;
+            $count_a = 0;
+            $count_b = 0;
+
+            my $match_a = ($re->[1] =~ $re->[2]) || 0;
+            my $match_b = ($re->[1] =~ $re->[3]) || 0;
+
+            iseq($match_a, $re->[0], "match a " . ($re->[0] ? "succeeded" : "failed") . " ($c)");
+            iseq($match_b, $re->[0], "match b " . ($re->[0] ? "succeeded" : "failed") . " ($c)");
+            iseq($count_a, $re->[4], "count a ($c)");
+            iseq($count_b, $re->[4], "count b ($c)");
+        }
+    }
+
+    {   # Bleadperl v5.13.8-292-gf56b639 breaks NEZUMI/Unicode-LineBreak-1.011
+        # \xdf in lookbehind failed to compile as is multi-char fold
+        eval_ok 'qr{
+            (?u: (?<=^url:) |
+                 (?<=[/]) (?=[^/]) |
+                 (?<=[^-.]) (?=[-~.,_?\#%=&]) |
+                 (?<=[=&]) (?=.)
+            )}iox', "Lookbehind with \\xdf matchable compiles";
+    }
 
     #
     # Keep the following tests last -- they may crash perl
@@ -1771,60 +2158,20 @@ sub run_tests {
         iseq $_, "!Bang!1!Bang!2!Bang!3!Bang!";
     }
 
-    {
-        use re 'eval';
-        local $Message = 'Test if $^N and $+ work in (?{{})';
-        our @ctl_n = ();
-        our @plus = ();
-        our $nested_tags;
-        $nested_tags = qr{
-            <
-               ((\w)+)
-               (?{
-                       push @ctl_n, (defined $^N ? $^N : "undef");
-                       push @plus, (defined $+ ? $+ : "undef");
-               })
-            >
-            (??{$nested_tags})*
-            </\s* \w+ \s*>
-        }x;
-
-
-        my $c = 0;
-        for my $test (
-            # Test structure:
-            #  [ Expected result, Regex, Expected value(s) of $^N, Expected value(s) of $+ ]
-            [ 1, qr#^$nested_tags$#, "bla blubb bla", "a b a" ],
-            [ 1, qr#^($nested_tags)$#, "bla blubb <bla><blubb></blubb></bla>", "a b a" ],
-            [ 1, qr#^(|)$nested_tags$#, "bla blubb bla", "a b a" ],
-            [ 1, qr#^(?:|)$nested_tags$#, "bla blubb bla", "a b a" ],
-            [ 1, qr#^<(bl|bla)>$nested_tags<(/\1)>$#, "blubb /bla", "b /bla" ],
-            [ 1, qr#(??{"(|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
-            [ 1, qr#^(??{"(bla|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
-            [ 1, qr#^(??{"(|)"})(??{$nested_tags})$#, "bla blubb undef", "a b undef" ],
-            [ 1, qr#^(??{"(?:|)"})$nested_tags$#, "bla blubb bla", "a b a" ],
-            [ 1, qr#^((??{"(?:bla|)"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
-            [ 1, qr#^((??{"(?!)?"}))((??{$nested_tags}))$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
-            [ 1, qr#^((??{"(?:|<(/?bla)>)"}))((??{$nested_tags}))\1$#, "bla blubb <bla><blubb></blubb></bla>", "a b <bla><blubb></blubb></bla>" ],
-            [ 0, qr#^((??{"(?!)"}))?((??{$nested_tags}))(?!)$#, "bla blubb undef", "a b undef" ],
-
-        ) { #"#silence vim highlighting
-            $c++;
-            @ctl_n = ();
-            @plus = ();
-            my $match = (("<bla><blubb></blubb></bla>" =~ $test->[1]) ? 1 : 0);
-            push @ctl_n, (defined $^N ? $^N : "undef");
-            push @plus, (defined $+ ? $+ : "undef");
-            ok($test->[0] == $match, "match $c");
-            if ($test->[0] != $match) {
-              # unset @ctl_n and @plus
-              @ctl_n = @plus = ();
-            }
-            iseq("@ctl_n", $test->[2], "ctl_n $c");
-            iseq("@plus", $test->[3], "plus $c");
-        }
+    { 
+        # Earlier versions of Perl said this was fatal.
+        local $Message = "U+0FFFF shouldn't crash the regex engine";
+        no warnings 'utf8';
+        my $a = eval "chr(65535)";
+        use warnings;
+        my $warning_message;
+        local $SIG{__WARN__} = sub { $warning_message = $_[0] };
+        eval $a =~ /[a-z]/;
+        ok(1);  # If it didn't crash, it worked.
     }
 
+    # !!! NOTE that tests that aren't at all likely to crash perl should go
+    # a ways above, above these last ones.
 } # End of sub run_tests
 
 1;