Skip to content

Commit

Permalink
reparse compile-time /(?{})/ in right scope
Browse files Browse the repository at this point in the history
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.
  • Loading branch information
iabyn committed Aug 6, 2013
1 parent 11609d9 commit c3923c3
Show file tree
Hide file tree
Showing 2 changed files with 47 additions and 1 deletion.
6 changes: 5 additions & 1 deletion pp_ctl.c
Expand Up @@ -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--) {
Expand Down
42 changes: 42 additions & 0 deletions t/re/overload.t
Expand Up @@ -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();

0 comments on commit c3923c3

Please sign in to comment.