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.

diff --git a/pp_ctl.c b/pp_ctl.c
index ff3d661..1f9432b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3274,7 +3274,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 dc76663..dba0357 100644 (file)
--- 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();