The regex engine can't assume that SvSCREAM() remains set on its target.

Callers to the engine set REXEC_SCREAM in the flags when the target scalar is
studied, and the engine should use the study data. It's possible for embedded
code blocks to cause the target scalar to stop being studied. Hence the engine
needs to check for this, instead of simply assuming that the study data is
present and valid to read. This resolves #92696.

diff --git a/regexec.c b/regexec.c
index 3dd7ba5..6ae2770 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -692,7 +692,7 @@ Perl_re_intuit_start(pTHX_ REGEXP * const rx, SV *sv, char *strpos,
             (IV)prog->check_end_shift);
     });       
         
-    if (flags & REXEC_SCREAM) {
+    if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
        I32 p = -1;                     /* Internal iterator of scream. */
        I32 * const pp = data ? data->scream_pos : &p;
 
@@ -2289,7 +2289,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
        dontbother = end_shift;
        strend = HOPc(strend, -dontbother);
        while ( (s <= last) &&
-               ((flags & REXEC_SCREAM)
+               ((flags & REXEC_SCREAM) && SvSCREAM(sv)
                 ? (s = screaminstr(sv, must, HOP3c(s, back_min, (back_min<0 ? strbeg : strend)) - strbeg,
                                    end_shift, &scream_pos, 0))
                 : (s = fbm_instr((unsigned char*)HOP3(s, back_min, (back_min<0 ? strbeg : strend)),
@@ -2368,7 +2368,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, register char *stre
                utf8_target ? to_utf8_substr(prog) : to_byte_substr(prog);
            float_real = utf8_target ? prog->float_utf8 : prog->float_substr;
 
-           if (flags & REXEC_SCREAM) {
+           if ((flags & REXEC_SCREAM) && SvSCREAM(sv)) {
                last = screaminstr(sv, float_real, s - strbeg,
                                   end_shift, &scream_pos, 1); /* last one */
                if (!last)

diff --git a/t/op/study.t b/t/op/study.t
index 3733849..906aba9 100644 (file)
--- a/t/op/study.t
+++ b/t/op/study.t
@@ -7,7 +7,7 @@ BEGIN {
 }
 
 watchdog(10);
-plan(tests => 36);
+plan(tests => 43);
 use strict;
 use vars '$x';
 
@@ -109,3 +109,53 @@ TODO: {
     is($2, undef);
     is($_, 'A1A1');
 }
+
+{
+    my @got;
+    $a = "ydydydyd";
+    $b = "xdx";
+    push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 control');
+
+    @got = ();
+    $a = "ydydydyd";
+    $b = "xdx";
+    study $a;
+    push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 study $a');
+
+    @got = ();
+    $a = "ydydydyd";
+    $b = "xdx";
+    study $b;
+    push @got, $_ foreach $a =~ /[^x]d(?{})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 study $b');
+
+    @got = ();
+    $a = "ydydydyd";
+    $b = "xdx";
+    push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), nothing studied');
+
+    @got = ();
+    $a = "ydydydyd";
+    $b = "xdx";
+    my $c = 'zz';
+    study $c;
+    push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), $c studied');
+
+    @got = ();
+    $a = "ydydydyd";
+    $b = "xdx";
+    study $a;
+    push @got, $_ foreach $a =~ /[^x]d(?{study $b})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 study $b inside (?{}), $a studied');
+
+    @got = ();
+    $a = "ydydydyd";
+    $b = "xdx";
+    study $a;
+    push @got, $_ foreach $a =~ /[^x]d(?{$a .= ''})[^x]d/g;
+    is("@got", 'ydyd ydyd', '#92696 $a .= \'\' inside (?{}), $a studied');
+}