From 475ab7d9ee751e000e8aedb008fec6eb31273582 Mon Sep 17 00:00:00 2001
From: David Mitchell <davem@iabyn.com>
Date: Tue, 6 Aug 2013 16:34:50 +0100
Subject: reparse compile-time /(?{})/ in right scope

When a compile-time regex like /...(?{ code-block }) .../
is compiled in the presence of constant and concat overloading,
this can cause (still at compile-time) for the pattern to be evaled and
re-compiled, in order to re-compile any code-blocks that got messed up
during the overloading and thus whose text no longer matches that which
the perl parser previously compiled.

When this happens, eval_sv() happens to be called when the perl parser is
still in compiling state; normally its called from running state.
This tickles an undiscovered bug in Perl_find_runcv_where(), which
finds the current cop sequence by looking at PL_curcop->cop_seq.
At compile time, we need to get it from PL_cop_seqmax instead.

(cherry picked from commit c3923c33af542d8764d5a1e4eb5d7b311f443b89)
---
 pp_ctl.c        |  6 +++++-
 t/re/overload.t | 42 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 47 insertions(+), 1 deletion(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index b0bc528bae..c8735e9afc 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3281,7 +3281,11 @@ Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp)
     int		 level = 0;
 
     if (db_seqp)
-	*db_seqp = PL_curcop->cop_seq;
+	*db_seqp =
+            PL_curcop == &PL_compiling
+                ? PL_cop_seqmax
+                : PL_curcop->cop_seq;
+
     for (si = PL_curstackinfo; si; si = si->si_prev) {
         I32 ix;
 	for (ix = si->si_cxix; ix >= 0; ix--) {
diff --git a/t/re/overload.t b/t/re/overload.t
index dc76663fee..dba0357a4f 100644
--- a/t/re/overload.t
+++ b/t/re/overload.t
@@ -220,5 +220,47 @@ no  warnings 'syntax';
 
 }
 
+{
+
+    # if the pattern gets silently re-parsed, ensure that any eval'ed
+    # code blocks get the correct lexical scope. The overloading of
+    # concat, along with the modification of the text of the code block,
+    # ensures that it has to be re-compiled.
+
+    {
+	package OL_MOD;
+	use overload
+	    q{""} => sub { my ($pat) = @_; $pat->[0] },
+	    q{.}  => sub {
+			    my ($a1, $a2) = @_;
+			    $a1 = $a1->[0] if ref $a1;
+			    $a2 = $a2->[0] if ref $a2;
+			    my $s = "$a1$a2";
+			    $s =~ s/x_var/y_var/;
+			    bless [ $s ];
+		     },
+	;
+    }
+
+
+    BEGIN {
+	overload::constant qr => sub { bless [ $_[0] ], 'OL_MOD' };
+    }
+
+    $::x_var  =		# duplicate to avoid 'only used once' warning
+    $::x_var  = "ABC";
+    my $x_var = "abc";
+
+    $::y_var  =		# duplicate to avoid 'only used once' warning
+    $::y_var  = "XYZ";
+    my $y_var    = "xyz";
+
+    use re 'eval';
+    my $a = 'a';
+    ok("xyz"  =~ m{^(??{ $x_var })$},   "OL_MOD");
+    ok("xyza" =~ m{^(??{ $x_var })$a$}, "OL_MOD runtime");
+}
+
+
 
 done_testing();
-- 
cgit v1.2.1