In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/cb93cfd8a42cd5393400053115e38b60d71174cc?hp=f4eedc6b8c8773817aee4a0424179660710446bf>
- Log ----------------------------------------------------------------- commit cb93cfd8a42cd5393400053115e38b60d71174cc Author: Father Chrysostomos <[email protected]> Date: Mon Oct 13 14:48:13 2014 -0700 aelemfast_lex in aassign_common_vars_aliases_only S_aassign_common_vars_aliases_only needs to handle aelemfast_lex, otherwise we miss some rare cases where we have aliased scalars and elements on both sides of the assignment. M op.c M t/op/lvref.t commit 78fdc7f3d1fcc82e28dcb62b86226d255c58b2be Author: Father Chrysostomos <[email protected]> Date: Mon Oct 13 14:46:53 2014 -0700 Handle aelemfast_lex in S_aassign_common_vars This was a missed opportunity for optimisation. Prior to be9de18 it was optimised, because S_aassign_common_vars was called earlier in the compilation phase, before the aelemfast optimisation. M op.c M t/op/opt.t commit e2a5b72044fcee8d7cee477e32e2d7724b4b7bd3 Author: Father Chrysostomos <[email protected]> Date: Mon Oct 13 12:35:49 2014 -0700 op.c: Skip priv flags assert if ppaddr changes because an XS module is probably installing its own ppaddr, in which case it knows more about the private flags than we do. M op.c ----------------------------------------------------------------------- Summary of changes: op.c | 6 +++++- t/op/lvref.t | 17 ++++++++++++++++- t/op/opt.t | 10 +++++++--- 3 files changed, 28 insertions(+), 5 deletions(-) diff --git a/op.c b/op.c index 6b87a55..6d6b1a8 100644 --- a/op.c +++ b/op.c @@ -695,7 +695,9 @@ Perl_op_free(pTHX_ OP *o) /* an op should only ever acquire op_private flags that we know about. * If this fails, you may need to fix something in regen/op_private */ - assert(!(o->op_private & ~PL_op_private_valid[type])); + if (o->op_ppaddr == PL_ppaddr[o->op_type]) { + assert(!(o->op_private & ~PL_op_private_valid[type])); + } if (o->op_private & OPpREFCOUNTED) { switch (type) { @@ -5928,6 +5930,7 @@ S_aassign_common_vars(pTHX_ OP* o) else if (curop->op_type == OP_PADSV || curop->op_type == OP_PADAV || curop->op_type == OP_PADHV || + curop->op_type == OP_AELEMFAST_LEX || curop->op_type == OP_PADANY) { padcheck: @@ -5991,6 +5994,7 @@ S_aassign_common_vars_aliases_only(pTHX_ OP *o) if ((curop->op_type == OP_PADSV || curop->op_type == OP_PADAV || curop->op_type == OP_PADHV || + curop->op_type == OP_AELEMFAST_LEX || curop->op_type == OP_PADANY) && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX) return TRUE; diff --git a/t/op/lvref.t b/t/op/lvref.t index 747c127..d55ccd2 100644 --- a/t/op/lvref.t +++ b/t/op/lvref.t @@ -4,7 +4,7 @@ BEGIN { set_up_inc("../lib"); } -plan 152; +plan 153; eval '\$x = \$y'; like $@, qr/^Experimental lvalue references not enabled/, @@ -572,3 +572,18 @@ SKIP: { \($x) = \$y; goto do_test2; } +{ + my @a; + goto do_aliasing3; + + do_test3: + @a[0,1] = qw<a b>; + my($y,$x) = ($a[0],$a[1]); + is "@a", 'b a', + 'aelemfast_lex-to-scalar list assignment "before" aliasing'; + last; + + do_aliasing3: + \(@a) = \($x,$y); + goto do_test3; +} diff --git a/t/op/opt.t b/t/op/opt.t index 892ec95..71eedcf 100644 --- a/t/op/opt.t +++ b/t/op/opt.t @@ -9,21 +9,25 @@ BEGIN { @INC = '../lib'; } -plan 18; +plan 19; use B qw 'svref_2object OPpASSIGN_COMMON'; # aassign with no common vars +for ('my ($self) = @_', + 'my @x; @y = $x[0]', # aelemfast_lex + ) { + my $sub = eval "sub { $_ }"; my $last_expr = - svref_2object(sub { my($self) = @_ })->ROOT->first->last; + svref_2object($sub)->ROOT->first->last; if ($last_expr->name ne 'aassign') { die "Expected aassign but found ", $last_expr->name, "; this test needs to be rewritten" } is $last_expr->private & OPpASSIGN_COMMON, 0, - 'no ASSIGN_COMMON for my($self) = @_'; + "no ASSIGN_COMMON for $_"; } -- Perl5 Master Repository
