This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add Regexp::Keep \K functionality to regex engine as well as add \v and \V, cleanup...
[perl5.git] / t / op / pat.t
index e20a6f7..94703c1 100755 (executable)
@@ -12,6 +12,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
 }
+our $Message = "Noname test";
 
 eval 'use Config';          #  Defaults assumed if this fails
 
@@ -476,27 +477,27 @@ print "not " unless $^R eq '79' and $x eq '12';
 print "ok $test\n";
 $test++;
 
-print "not " unless qr/\b\v$/i eq '(?i-xsm:\bv$)';
+print "not " unless qr/\b\v$/i eq '(?i-xsm:\b\v$)';
 print "ok $test\n";
 $test++;
 
-print "not " unless qr/\b\v$/s eq '(?s-xim:\bv$)';
+print "not " unless qr/\b\v$/s eq '(?s-xim:\b\v$)';
 print "ok $test\n";
 $test++;
 
-print "not " unless qr/\b\v$/m eq '(?m-xis:\bv$)';
+print "not " unless qr/\b\v$/m eq '(?m-xis:\b\v$)';
 print "ok $test\n";
 $test++;
 
-print "not " unless qr/\b\v$/x eq '(?x-ism:\bv$)';
+print "not " unless qr/\b\v$/x eq '(?x-ism:\b\v$)';
 print "ok $test\n";
 $test++;
 
-print "not " unless qr/\b\v$/xism eq '(?msix:\bv$)';
+print "not " unless qr/\b\v$/xism eq '(?msix:\b\v$)';
 print "ok $test\n";
 $test++;
 
-print "not " unless qr/\b\v$/ eq '(?-xism:\bv$)';
+print "not " unless qr/\b\v$/ eq '(?-xism:\b\v$)';
 print "ok $test\n";
 $test++;
 
@@ -874,9 +875,7 @@ $foo='aabbccddeeffgg';
 pos($foo)=1;
 
 $foo=~/.\G(..)/g;
-print "not " unless($1 eq 'ab');
-print "ok $test\n";
-$test++;
+iseq($1,'ab');
 
 pos($foo) += 1;
 $foo=~/.\G(..)/g;
@@ -1047,9 +1046,7 @@ $test++;
 
 @b = grep(/\w/,@a);
 @c = grep(/[\w]/,@a);
-print "not " if "@b" ne "@c";
-print "ok $test\n";
-$test++;
+iseq("@b","@c");
 
 # see if backtracking optimization works correctly
 "\n\n" =~ /\n  $ \n/x or print "not ";
@@ -2037,7 +2034,8 @@ $test = 687;
 sub ok ($;$) {
     my($ok, $name) = @_;
 
-    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test, $name||'unnamed';
+    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+        ($name||$Message)."\tLine ".((caller)[2]);
 
     printf "# Failed test at line %d\n", (caller)[2] unless $ok;
 
@@ -3216,10 +3214,10 @@ $_ = "x"; s/x/func "in multiline subst"/em;
 #$_ = "x"; /x(?{func "in regexp"})/;
 #$_ = "x"; /x(?{func "in multiline regexp"})/m;
 
-# bug #19049
+# bug RT#19049
 $_="abcdef\n";
 @x = m/./g;
-ok("abcde" eq "$`", '# TODO #19049 - global match not setting $`');
+ok("abcde" eq "$`", 'RT#19049 - global match not setting $`');
 
 ok("123\x{100}" =~ /^.*1.*23\x{100}$/, 'uft8 + multiple floating substr');
 
@@ -3657,6 +3655,114 @@ SKIP:{
     }
         
 }
+{
+    my $s='123453456';
+    $s=~s/(?<digits>\d+)\k<digits>/$+{digits}/;
+    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///');    
+}
+
+{
+    my @ary = (
+       pack('U', 0x00F1),            # n-tilde
+       '_'.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 + _
+    );
+    for my $uni (@ary) {
+       my ($r1, $c1, $r2, $c2) = eval qq{
+           use utf8;
+           scalar("..foo foo.." =~ /(?'${uni}'foo) \\k'${uni}'/),
+               \$+{${uni}},
+           scalar("..bar bar.." =~ /(?<${uni}>bar) \\k<${uni}>/),
+               \$+{${uni}};
+       };
+       ok($r1,                         "Named capture UTF (?'')");
+       ok(defined $c1 && $c1 eq 'foo', "Named capture UTF \%+");
+       ok($r2,                         "Named capture UTF (?<>)");
+       ok(defined $c2 && $c2 eq 'bar', "Named capture UTF \%+");
+    }
+}
+
+sub iseq($$;$) { 
+    my ( $got, $expect, $name)=@_;
+    
+    $_=defined($_) ? "'$_'" : "undef"
+        for $got, $expect;
+        
+    my $ok=  $got eq $expect;
+        
+    printf "%sok %d - %s\n", ($ok ? "" : "not "), $test,
+        ($name||$Message)."\tLine ".((caller)[2]);
+
+    printf "# Failed test at line %d\n".
+           "# expected: %s\n". 
+           "#   result: %s\n", 
+           (caller)[2], $expect, $got
+        unless $ok;
+
+    $test++;
+    return $ok;
+}   
+{
+    my $s='foo bar baz';
+    my (@k,@v,@fetch,$res);
+    my $count= 0;
+    my @names=qw($+{A} $+{B} $+{C});
+    if ($s=~/(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz)/) {
+        while (my ($k,$v)=each(%+)) {
+            $count++;
+        }
+        @k=sort keys(%+);
+        @v=sort values(%+);
+        $res=1;
+        push @fetch,
+            [ "$+{A}", "$1" ],
+            [ "$+{B}", "$2" ],
+            [ "$+{C}", "$3" ],
+        ;
+    } 
+    foreach (0..2) {
+        if ($fetch[$_]) {
+            iseq($fetch[$_][0],$fetch[$_][1],$names[$_]);
+        } else {
+            ok(0, $names[$_]);
+        }
+    }
+    iseq($res,1,"$s~=/(?<A>foo)\s+(?<B>bar)?\s+(?<C>baz)/");
+    iseq($count,3,"Got 3 keys in %+ via each");
+    iseq(0+@k, 3, 'Got 3 keys in %+ via keys');
+    iseq("@k","A B C", "Got expected keys");
+    iseq("@v","bar baz foo", "Got expected values");
+    eval'
+        print for $+{this_key_doesnt_exist};
+    ';
+    ok(!$@,'lvalue $+{...} should not throw an exception');
+}
+{
+    my $s='foo bar baz';
+    my @res;
+    if ('1234'=~/(?<A>1)(?<B>2)(?<A>3)(?<B>4)/) {
+        foreach my $name (sort keys(%-)) {
+            my $ary = $-{$name};
+            foreach my $idx (0..$#$ary) {
+                push @res,"$name:$idx:$ary->[$idx]";
+            }
+        }
+    }
+    my @expect=qw(A:0:1 A:1:3 B:0:2 B:1:4);
+    iseq("@res","@expect","Check %-");
+    eval'
+        print for $-{this_key_doesnt_exist};
+    ';
+    ok(!$@,'lvalue $-{...} should not throw an exception');
+}
 # stress test CURLYX/WHILEM.
 #
 # This test includes varying levels of nesting, and according to
@@ -3664,7 +3770,9 @@ SKIP:{
 # CURLYX and WHILEM blocks, except those related to LONGJMP, the
 # super-linear cache and warnings. It executes about 0.5M regexes
 
-{
+if ($ENV{PERL_SKIP_PSYCHO_TEST}){
+  printf "ok %d Skip: No psycho tests\n", $test++;
+} else {    
   my $r = qr/^
            (?:
                ( (?:a|z+)+ )
@@ -3760,8 +3868,417 @@ SKIP:{
   ok($ok, $msg);
 }
 
+# \, breaks {3,4}
+ok("xaaay"    !~ /xa{3\,4}y/, "\, in a pattern");
+ok("xa{3,4}y" =~ /xa{3\,4}y/, "\, in a pattern");
+
+# \c\ followed by _
+ok("x\c_y"    !~ /x\c\_y/,    "\_ in a pattern");
+ok("x\c\_y"   =~ /x\c\_y/,    "\_ in a pattern");
+
+# \c\ followed by other characters
+for my $c ("z", "\0", "!", chr(254), chr(256)) {
+    my $targ = "a\034$c";
+    my $reg  = "a\\c\\$c";
+    ok(eval("qq/$targ/ =~ /$reg/"), "\\c\\ in pattern");
+}
 
+{
+    my $str='abc'; 
+    my $count=0;
+    my $mval=0;
+    my $pval=0;
+    while ($str=~/b/g) { $mval=$#-; $pval=$#+; $count++ }
+    iseq($mval,0,"\@- should be empty [RT#36046]");
+    iseq($pval,0,"\@+ should be empty [RT#36046]");
+    iseq($count,1,"should have matched once only [RT#36046]");
+}
+
+{   # Test the (*PRUNE) pattern
+    our $count = 0;
+    'aaab'=~/a+b?(?{$count++})(*FAIL)/;
+    iseq($count,9,"expect 9 for no (*PRUNE)");
+    $count = 0;
+    'aaab'=~/a+b?(*PRUNE)(?{$count++})(*FAIL)/;
+    iseq($count,3,"expect 3 with (*PRUNE)");
+    local $_='aaab';
+    $count=0;
+    1 while /.(*PRUNE)(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.(*PRUNE)/");
+    $count = 0;
+    'aaab'=~/a+b?(??{'(*PRUNE)'})(?{$count++})(*FAIL)/;
+    iseq($count,3,"expect 3 with (*PRUNE)");
+    local $_='aaab';
+    $count=0;
+    1 while /.(??{'(*PRUNE)'})(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.(*PRUNE)/");
+}
+{   # Test the \v form of the (*PRUNE) pattern
+    our $count = 0;
+    'aaab'=~/a+b?(?{$count++})(*FAIL)/;
+    iseq($count,9,"expect 9 for no \\v");
+    $count = 0;
+    'aaab'=~/a+b?\v(?{$count++})(*FAIL)/;
+    iseq($count,3,"expect 3 with \\v");
+    local $_='aaab';
+    $count=0;
+    1 while /.\v(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.\\v/");
+    $count = 0;
+    'aaab'=~/a+b?(??{'\v'})(?{$count++})(*FAIL)/;
+    iseq($count,3,"expect 3 with \\v");
+    local $_='aaab';
+    $count=0;
+    1 while /.(??{'\v'})(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.\\v/");
+}
+{   # Test the (*SKIP) pattern
+    our $count = 0;
+    'aaab'=~/a+b?(*SKIP)(?{$count++})(*FAIL)/;
+    iseq($count,1,"expect 1 with (*SKIP)");
+    local $_='aaab';
+    $count=0;
+    1 while /.(*SKIP)(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.(*SKIP)/");
+    $_='aaabaaab';
+    $count=0;
+    our @res=();
+    1 while /(a+b?)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
+    iseq($count,2,"Expect 2 with (*SKIP)" );
+    iseq("@res","aaab aaab","adjacent (*SKIP) works as expected" );
+}
+{   # Test the \V form of the (*SKIP) pattern
+    our $count = 0;
+    'aaab'=~/a+b?\V(?{$count++})(*FAIL)/;
+    iseq($count,1,"expect 1 with \\V");
+    local $_='aaab';
+    $count=0;
+    1 while /.\V(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.\\V/");
+    $_='aaabaaab';
+    $count=0;
+    our @res=();
+    1 while /(a+b?)\V(?{$count++; push @res,$1})(*FAIL)/g;
+    iseq($count,2,"Expect 2 with \\V" );
+    iseq("@res","aaab aaab","adjacent \\V works as expected" );
+}
+{   # Test the (*SKIP) pattern
+    our $count = 0;
+    'aaab'=~/a+b?(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/;
+    iseq($count,1,"expect 1 with (*SKIP)");
+    local $_='aaab';
+    $count=0;
+    1 while /.(*MARK:foo)(*SKIP)(?{$count++})(*FAIL)/g;
+    iseq($count,4,"/.(*SKIP)/");
+    $_='aaabaaab';
+    $count=0;
+    our @res=();
+    1 while /(a+b?)(*MARK:foo)(*SKIP)(?{$count++; push @res,$1})(*FAIL)/g;
+    iseq($count,2,"Expect 2 with (*SKIP)" );
+    iseq("@res","aaab aaab","adjacent (*SKIP) works as expected" );
+}
+{   # Test the (*SKIP) pattern
+    our $count = 0;
+    'aaab'=~/a*(*MARK:a)b?(*MARK:b)(*SKIP:a)(?{$count++})(*FAIL)/;
+    iseq($count,3,"expect 3 with *MARK:a)b?(*MARK:b)(*SKIP:a)");
+    local $_='aaabaaab';
+    $count=0;
+    our @res=();
+    1 while /(a*(*MARK:a)b?)(*MARK:x)(*SKIP:a)(?{$count++; push @res,$1})(*FAIL)/g;
+    iseq($count,5,"Expect 5 with (*MARK:a)b?)(*MARK:x)(*SKIP:a)" );
+    iseq("@res","aaab b aaab b ","adjacent (*MARK:a)b?)(*MARK:x)(*SKIP:a) works as expected" );
+}
+{   # Test the (*COMMIT) pattern
+    our $count = 0;
+    'aaabaaab'=~/a+b?(*COMMIT)(?{$count++})(*FAIL)/;
+    iseq($count,1,"expect 1 with (*COMMIT)");
+    local $_='aaab';
+    $count=0;
+    1 while /.(*COMMIT)(?{$count++})(*FAIL)/g;
+    iseq($count,1,"/.(*COMMIT)/");
+    $_='aaabaaab';
+    $count=0;
+    our @res=();
+    1 while /(a+b?)(*COMMIT)(?{$count++; push @res,$1})(*FAIL)/g;
+    iseq($count,1,"Expect 1 with (*COMMIT)" );
+    iseq("@res","aaab","adjacent (*COMMIT) works as expected" );
+}
+{
+    # Test named commits and the $REGERROR var
+    our $REGERROR;
+    for my $name ('',':foo') 
+    {
+        for my $pat ("(*PRUNE$name)",
+                     ($name? "(*MARK$name)" : "")
+                     . "(*SKIP$name)",
+                     "(*COMMIT$name)")
+        {                         
+            for my $suffix ('(*FAIL)','') 
+            {
+                'aaaab'=~/a+b$pat$suffix/;
+                iseq(
+                    $REGERROR,
+                    ($suffix ? ($name ? 'foo' : "1") : ""),
+                    "Test $pat and \$REGERROR $suffix"
+                );
+            }
+        }
+    }      
+}    
+{
+    # Test named commits and the $REGERROR var
+    package Fnorble;
+    our $REGERROR;
+    for my $name ('',':foo') 
+    {
+        for my $pat ("(*PRUNE$name)",
+                     ($name? "(*MARK$name)" : "")
+                     . "(*SKIP$name)",
+                     "(*COMMIT$name)")
+        {                         
+            for my $suffix ('(*FAIL)','') 
+            {
+                'aaaab'=~/a+b$pat$suffix/;
+                ::iseq(
+                    $REGERROR,
+                    ($suffix ? ($name ? 'foo' : "1") : ""),
+                    "Test $pat and \$REGERROR $suffix"
+                );
+            }
+        }
+    }      
+}    
+{
+    # Test named commits and the $REGERROR var
+    local $Message = "\$REGERROR";
+    our $REGERROR;
+    for $word (qw(bar baz bop)) {
+        $REGERROR="";
+        "aaaaa$word"=~/a+(?:bar(*COMMIT:bar)|baz(*COMMIT:baz)|bop(*COMMIT:bop))(*FAIL)/;
+        iseq($REGERROR,$word);
+    }    
+}
+{   #Regression test for perlbug 40684
+    local $Message = "RT#40684 tests:";
+    my $s = "abc\ndef";
+    my $rex = qr'^abc$'m;
+    ok($s =~ m/$rex/);
+    ok($s =~ m/^abc$/m);
+}
+{
+    #Mindnumbingly simple test of (*THEN)
+    for ("ABC","BAX") {
+        ok(/A (*THEN) X | B (*THEN) C/x,"Simple (*THEN) test");
+    }
+}
+
+{
+    local $Message = "Relative Recursion";
+    my $parens=qr/(\((?:[^()]++|(?-1))*+\))/;
+    local $_='foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))';
+    my ($all,$one,$two)=('','','');
+    if (/foo $parens \s* \+ \s* bar $parens/x) {
+       $all=$&;
+       $one=$1;
+       $two=$2;
+    }
+    iseq($one, '((2*3)+4-3)');
+    iseq($two, '(2*(3+4)-1*(2-3))');
+    iseq($all, 'foo((2*3)+4-3) + bar(2*(3+4)-1*(2-3))');
+    iseq($all, $_);
+}
+{
+    my $spaces="      ";
+    local $_=join 'bar',$spaces,$spaces;
+    our $count=0;
+    s/(?>\s+bar)(?{$count++})//g;
+    iseq($_,$spaces,"SUSPEND final string");
+    iseq($count,1,"Optimiser should have prevented more than one match");
+}
+{
+    local $Message = "RT#36909 test";
+    $^R = 'Nothing';
+    {
+        local $^R = "Bad";
+        ok('x foofoo y' =~ m{
+         (foo) # $^R correctly set
+        (?{ "last regexp code result" })
+        }x);
+        iseq($^R,'last regexp code result');
+    }
+    iseq($^R,'Nothing');
+    {
+        local $^R = "Bad";
+
+        ok('x foofoo y' =~ m{
+         (?:foo|bar)+ # $^R correctly set
+        (?{"last regexp code result"})
+        }x);
+        iseq($^R,'last regexp code result');
+    }
+    iseq($^R,'Nothing');
+
+    {
+        local $^R = "Bad";
+        ok('x foofoo y' =~ m{
+         (foo|bar)\1+ # $^R undefined
+        (?{"last regexp code result"})
+        }x);
+        iseq($^R,'last regexp code result');
+    }
+    iseq($^R,'Nothing');
+}
+{
+    local $Message="RT#22395";
+    our $count;
+    for my $l (10,100,1000) {
+       $count=0;
+       ('a' x $l) =~ /(.*)(?{$count++})[bc]/;
+       iseq( $count, $l + 1, "# TODO Should be L+1 not L*(L+3)/2 (L=$l)");
+    }
+}
+{
+    local $Message = "RT#22614";
+    local $_='ab';
+    our @len=();
+    /(.){1,}(?{push @len,0+@-})(.){1,}(?{})^/;
+    iseq("@len","2 2 2");
+}
+{
+    local $Message = "RT#18209";
+    my $text = ' word1 word2 word3 word4 word5 word6 ';
+
+    my @words = ('word1', 'word3', 'word5');
+    my $count;
+    foreach my $word (@words){
+        $text =~ s/$word\s//gi; # Leave a space to seperate words in the resultant str.
+        # The following block is not working.
+        if($&){
+            $count++;
+        }
+        # End bad block
+    }
+    iseq($count,3);
+    iseq($text,' word2 word4 word6 ');
+}
+{
+    # RT#6893
+    local $_= qq(A\nB\nC\n); 
+    my @res;
+    while (m#(\G|\n)([^\n]*)\n#gsx) 
+    { 
+        push @res,"$2"; 
+        last if @res>3;
+    }
+    iseq("@res","A B C","RT#6893: /g pattern shouldn't infinite loop");
+}
+
+{
+    # From Message-ID: <877ixs6oa6.fsf@k75.linux.bogus>
+    my $dow_name= "nada";
+    my $parser = "(\$dow_name) = \$time_string =~ /(D\x{e9}\\ C\x{e9}adaoin|D\x{e9}\\ Sathairn|\\w+|\x{100})/";
+    my $time_string = "D\x{e9} C\x{e9}adaoin";
+    eval $parser;
+    ok(!$@,"Test Eval worked");
+    iseq($dow_name,$time_string,"UTF8 trie common prefix extraction");
+}
+
+{
+    my $v;
+    ($v='bar')=~/(\w+)/g;
+    $v='foo';
+    iseq("$1",'bar','$1 is safe after /g - may fail due to specialized config in pp_hot.c')
+}
+{
+    local $Message = "http://nntp.perl.org/group/perl.perl5.porters/118663";
+    my $qr_barR1 = qr/(bar)\g-1/;
+    ok("foobarbarxyz" =~ $qr_barR1);
+    ok("foobarbarxyz" =~ qr/foo${qr_barR1}xyz/);
+    ok("foobarbarxyz" =~ qr/(foo)${qr_barR1}xyz/);
+    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 = "RT#41010";
+    my @tails=('','(?(1))','(|)','()?');    
+    my @quants=('*','+');
+    my $doit=sub {
+        my $pats= shift;
+        for (@_) {
+            for my $pat (@$pats) {
+                for my $quant (@quants) {
+                    for my $tail (@tails) {
+                        my $re = "($pat$quant\$)$tail";
+                        ok(/$re/ && $1 eq $_,"'$_'=~/$re/");
+                        ok(/$re/m && $1 eq $_,"'$_'=~/$re/m");
+                    }
+                }
+            }
+       }
+    };    
+    
+    my @dpats=( 
+                '\d',
+                '[1234567890]',
+                '(1|[23]|4|[56]|[78]|[90])',
+                '(?:1|[23]|4|[56]|[78]|[90])',
+                '(1|2|3|4|5|6|7|8|9|0)',
+                '(?:1|2|3|4|5|6|7|8|9|0)',
+             );
+    my @spats=('[ ]',' ','( |\t)','(?: |\t)','[ \t]','\s');
+    my @sstrs=('  ');
+    my @dstrs=('12345');
+    $doit->(\@spats,@sstrs);
+    $doit->(\@dpats,@dstrs);
+}
+{
+    local $Message = "\$REGMARK";
+    our @r=();
+    ok('foofoo' =~ /foo (*MARK:foo) (?{push @r,$REGMARK}) /x);
+    iseq("@r","foo");           
+    iseq($REGMARK,"foo");
+    ok('foofoo' !~ /foo (*MARK:foo) (*FAIL) /x);
+    ok(!$REGMARK);
+    iseq($REGERROR,'foo');
+}
+{
+    my $x;
+    $x = "abc.def.ghi.jkl";
+    $x =~ s/.*\K\..*//;
+    ok($x eq "abc.def.ghi");
+    
+    $x = "one two three four";
+    $x =~ s/o+ \Kthree//g;
+    ok($x eq "one two  four");
+    
+    $x = "abcde";
+    $x =~ s/(.)\K/$1/g;
+    ok($x eq "aabbccddee");
+}
+
+
+# Test counter is at bottom of file. Put new tests above here.
+#-------------------------------------------------------------------
 # Keep the following tests last -- they may crash perl
+{   
+    # RT#19049 / RT#38869
+    my @list = (
+        'ab cdef', # matches regex
+        ( 'e' x 40000 ) .'ab c' # matches not, but 'ab c' matches part of it
+    );
+    my $y;
+    my $x;
+    foreach (@list) {
+        m/ab(.+)cd/i; # the ignore-case seems to be important
+        $y = $1; # use $1, which might not be from the last match!
+        $x = substr($list[0],$-[0],$+[0]-$-[0]);
+    }
+    iseq($y,' ',
+        'pattern in a loop, failure should not affect previous success');
+    iseq($x,'ab cd',
+        'pattern in a loop, failure should not affect previous success');
+}
 
 ok(("a" x (2**15 - 10)) =~ /^()(a|bb)*$/, "Recursive stack cracker: #24274")
     or print "# Unexpected outcome: should pass or crash perl\n";
@@ -3770,6 +4287,27 @@ ok((q(a)x 100) =~ /^(??{'(.)'x 100})/,
         "Regexp /^(??{'(.)'x 100})/ crashes older perls")
     or print "# Unexpected outcome: should pass or crash perl\n";
 
+eval '/\k/';
+ok($@=~/\QSequence \k... not terminated in regex;\E/);
+
+{
+    local $Message = "substitution with lookahead (possible segv)";
+    $_="ns1ns1ns1";
+    s/ns(?=\d)/ns_/g;
+    iseq($_,"ns_1ns_1ns_1");
+    $_="ns1";
+    s/ns(?=\d)/ns_/;
+    iseq($_,"ns_1");
+    $_="123";
+    s/(?=\d+)|(?<=\d)/!Bang!/g;
+    iseq($_,"!Bang!1!Bang!2!Bang!3!Bang!");
+}
+
+# Put new tests above the dotted line about a page above this comment
+iseq(0+$::test,$::TestCount,"Got the right number of tests!");
 # Don't forget to update this!
-BEGIN{print "1..1264\n"};
+BEGIN {
+    $::TestCount = 1620;
+    print "1..$::TestCount\n";
+}