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.

2 files changed, 54 insertions, 4 deletions

diff --git a/regexec.c b/regexec.c
index 3dd7ba5a06..6ae2770be5 100644
--- 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 3733849647..906aba95a0 100644
--- 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');
+}