summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2013-04-17 17:51:16 +0100
committerDavid Mitchell <davem@iabyn.com>2013-04-20 17:23:13 +0100
commit491453ba443e114f751f325a4734b3d07b897606 (patch)
tree87b6bab51aef762b2ca41740bfdb3a5c2f3da024 /op.c
parentaec899470a3eab4f34d5c0404678e42b6823085a (diff)
downloadperl-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.c18
1 files changed, 17 insertions, 1 deletions
diff --git a/op.c b/op.c
index c502d3fe0d..a46d68b181 100644
--- a/op.c
+++ b/op.c
@@ -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;