From f1905e1b1b0d9cd2c673369524247d7a0280d166 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 30 Jun 2011 13:00:47 +0200
Subject: [PATCH] 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.
---
 regexec.c    |  6 +++---
 t/op/study.t | 52 +++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 54 insertions(+), 4 deletions(-)

diff --git a/regexec.c b/regexec.c
index 3dd7ba5..6ae2770 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 3733849..906aba9 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');
+}
-- 
2.7.4