diff options
author | David Mitchell <davem@iabyn.com> | 2013-04-17 17:51:16 +0100 |
---|---|---|
committer | David Mitchell <davem@iabyn.com> | 2013-04-20 17:23:13 +0100 |
commit | 491453ba443e114f751f325a4734b3d07b897606 (patch) | |
tree | 87b6bab51aef762b2ca41740bfdb3a5c2f3da024 /op.c | |
parent | aec899470a3eab4f34d5c0404678e42b6823085a (diff) | |
download | perl-491453ba443e114f751f325a4734b3d07b897606.tar.gz |
Handle /@a/ array expansion within regex engine
Previously /a@{b}c/ would be parsed as
regcomp('a', join($", @b), 'c')
This means that the array was flattened and its contents stringified before
hitting the regex engine.
Change it so that it is parsed as
regcomp('a', @b, 'c')
(but where the array isn't flattened, but rather just the AV itself is
pushed onto the stack, c.f. push @b, ....).
This means that the regex engine itself can process any qr// objects
within the array, and correctly extract out any previously-compiled
code blocks (thus preserving the correct closure behaviour). This is
an improvement on 5.16.x behaviour, and brings it into line with the
newish 5.17.x behaviour for *scalar* vars where they happen to hold
regex objects.
It also fixes a regression from 5.16.x, which meant that you suddenly
needed a 'use re eval' in scope if any of the elements of the array were
a qr// object with code blocks (RT #115004).
It also means that 'qr' overloading is now handled within interpolated
arrays as well as scalars:
use overload 'qr' => sub { return qr/a/ };
my $o = bless [];
my @a = ($o);
"a" =~ /^$o$/; # always worked
"a" =~ /^@a$/; # now works too
Diffstat (limited to 'op.c')
-rw-r--r-- | op.c | 18 |
1 files changed, 17 insertions, 1 deletions
@@ -4545,11 +4545,21 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor) LINKLIST(expr); - /* fix up DO blocks; treat each one as a separate little sub */ + /* fix up DO blocks; treat each one as a separate little sub; + * also, mark any arrays as LIST/REF */ if (expr->op_type == OP_LIST) { OP *o; for (o = cLISTOPx(expr)->op_first; o; o = o->op_sibling) { + + if (o->op_type == OP_PADAV || o->op_type == OP_RV2AV) { + assert( !(o->op_flags & OPf_WANT)); + /* push the array rather than its contents. The regex + * engine will retrieve and join the elements later */ + o->op_flags |= (OPf_WANT_LIST | OPf_REF); + continue; + } + if (!(o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL))) continue; o->op_next = NULL; /* undo temporary hack from above */ @@ -4583,6 +4593,12 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor) finalize_optree(o); } } + else if (expr->op_type == OP_PADAV || expr->op_type == OP_RV2AV) { + assert( !(expr->op_flags & OPf_WANT)); + /* push the array rather than its contents. The regex + * engine will retrieve and join the elements later */ + expr->op_flags |= (OPf_WANT_LIST | OPf_REF); + } PL_hints |= HINT_BLOCK_SCOPE; pm = (PMOP*)o; |