In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b13702a2b676b84fd7641c481a27970b9259f5ff?hp=2c3d35a4bbf08d71ed7e9a625c0e8262439abdfd>
- Log ----------------------------------------------------------------- commit b13702a2b676b84fd7641c481a27970b9259f5ff Author: David Mitchell <[email protected]> Date: Mon Aug 17 16:47:04 2015 +0100 ck_refassign: selectively copy OPpPAD_INTRO/STATE Previously this function unconditionally copied the OPpLVAL_INTRO and OPpPAD_STATE flags from the LH var op to the refassign op, even when those flag bits weren't used or meant something different. This commit makes the copying more selective. It also makes clear by code comments and asserts, that the refassign op uses bit 6, OPpPAD_STATE, to mean either that or OPpOUR_INTRO depending on the type of LHS. I couldn't think of any test that would would break under the old regime, but this future-proofs the code against new flags and meanings. M op.c M regen/op_private commit 92792a1c986f2a3bca788ec0500359ab8a53cc39 Author: David Mitchell <[email protected]> Date: Mon Aug 17 15:39:14 2015 +0100 t/perf/benchmarks: 5.004 compat make the tests in the benchmark file be compilable back to 5.004_05. (To go further back, it would need to avoid package names that start with digits, such as 'call::sub::3_args'). Basically avoid // and our. M t/perf/benchmarks ----------------------------------------------------------------------- Summary of changes: op.c | 11 ++++++++++- regen/op_private | 6 ++++++ t/perf/benchmarks | 40 ++++++++++++++++++++-------------------- 3 files changed, 36 insertions(+), 21 deletions(-) diff --git a/op.c b/op.c index 2d51b6d..ff2848a 100644 --- a/op.c +++ b/op.c @@ -10466,7 +10466,11 @@ Perl_ck_refassign(pTHX_ OP *o) assert (left); assert (left->op_type == OP_SREFGEN); - o->op_private = varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE); + o->op_private = 0; + /* we use OPpPAD_STATE in refassign to mean either of those things, + * and the code assumes the two flags occupy the same bit position + * in the various ops below */ + assert(OPpPAD_STATE == OPpOUR_INTRO); switch (varop->op_type) { case OP_PADAV: @@ -10474,12 +10478,15 @@ Perl_ck_refassign(pTHX_ OP *o) goto settarg; case OP_PADHV: o->op_private |= OPpLVREF_HV; + /* FALLTHROUGH */ case OP_PADSV: settarg: + o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)); o->op_targ = varop->op_targ; varop->op_targ = 0; PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX); break; + case OP_RV2AV: o->op_private |= OPpLVREF_AV; goto checkgv; @@ -10489,6 +10496,7 @@ Perl_ck_refassign(pTHX_ OP *o) /* FALLTHROUGH */ case OP_RV2SV: checkgv: + o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)); if (cUNOPx(varop)->op_first->op_type != OP_GV) goto bad; detach_and_stack: /* Point varop to its GV kid, detached. */ @@ -10511,6 +10519,7 @@ Perl_ck_refassign(pTHX_ OP *o) } case OP_AELEM: case OP_HELEM: + o->op_private |= (varop->op_private & OPpLVAL_INTRO); o->op_private |= OPpLVREF_ELEM; op_null(varop); stacked = TRUE; diff --git a/regen/op_private b/regen/op_private index 54980f0..51e01b6 100644 --- a/regen/op_private +++ b/regen/op_private @@ -477,6 +477,11 @@ addbits($_, 7 => qw(OPpPV_IS_UTF8 UTF)) for qw(last redo next goto dump); +# note that for refassign, this bit can mean either OPpPAD_STATE or +# OPpOUR_INTRO depending on the type of the LH child, .e.g. +# \our $foo = ... +# \state $foo = ... + addbits($_, 6 => qw(OPpPAD_STATE STATE)) for qw(padav padhv padsv lvavref lvref refassign pushmark); @@ -748,6 +753,7 @@ addbits($_, 3 OPpLVREF_CV CV )], }, + #6 => qw(OPpPAD_STATE STATE), #7 => qw(OPpLVAL_INTRO LVINTRO), ) for 'refassign', 'lvref'; diff --git a/t/perf/benchmarks b/t/perf/benchmarks index ae0f274..6baa3b2 100644 --- a/t/perf/benchmarks +++ b/t/perf/benchmarks @@ -93,44 +93,44 @@ 'expr::array::ref_expr_lex_3const' => { desc => '(lexical expr)->[const][const][const]', setup => 'my $r = [[[1,2]]]', - code => '($r//0)->[0][0][0]', + code => '($r||0)->[0][0][0]', }, 'expr::array::pkg_1const_0' => { desc => 'package $array[0]', - setup => 'our @a = (1)', + setup => '@a = (1)', code => '$a[0]', }, 'expr::array::pkg_1const_m1' => { desc => 'package $array[-1]', - setup => 'our @a = (1)', + setup => '@a = (1)', code => '$a[-1]', }, 'expr::array::pkg_2const' => { desc => 'package $array[const][const]', - setup => 'our @a = ([1,2])', + setup => '@a = ([1,2])', code => '$a[0][1]', }, 'expr::array::pkg_2var' => { desc => 'package $array[$i1][$i2]', - setup => 'our ($i1,$i2) = (0,1); our @a = ([1,2])', + setup => '($i1,$i2) = (0,1); @a = ([1,2])', code => '$a[$i1][$i2]', }, 'expr::array::ref_pkg_2var' => { desc => 'package $arrayref->[$i1][$i2]', - setup => 'our ($i1,$i2) = (0,1); our $r = [[1,2]]', + setup => '($i1,$i2) = (0,1); $r = [[1,2]]', code => '$r->[$i1][$i2]', }, 'expr::array::ref_pkg_3const' => { desc => 'package $arrayref->[const][const][const]', - setup => 'our $r = [[[1,2]]]', + setup => '$r = [[[1,2]]]', code => '$r->[0][0][0]', }, 'expr::array::ref_expr_pkg_3const' => { desc => '(package expr)->[const][const][const]', - setup => 'our $r = [[[1,2]]]', - code => '($r//0)->[0][0][0]', + setup => '$r = [[[1,2]]]', + code => '($r||0)->[0][0][0]', }, @@ -142,8 +142,8 @@ }, 'expr::arrayhash::pkg_3var' => { desc => 'package $h{$k1}[$i]{$k2}', - setup => 'our ($i, $k1, $k2) = (0,"foo","bar");' - . 'our %h = (foo => [ { bar => 1 } ])', + setup => '($i, $k1, $k2) = (0,"foo","bar");' + . '%h = (foo => [ { bar => 1 } ])', code => '$h{$k1}[$i]{$k2}', }, @@ -188,39 +188,39 @@ 'expr::hash::ref_expr_lex_3const' => { desc => '(lexical expr)->{const}{const}{const}', setup => 'my $r = {foo => { bar => { baz => 1 }}}', - code => '($r//0)->{foo}{bar}{baz}', + code => '($r||0)->{foo}{bar}{baz}', }, 'expr::hash::pkg_1const' => { desc => 'package $hash{const}', - setup => 'our %h = ("foo" => 1)', + setup => '%h = ("foo" => 1)', code => '$h{foo}', }, 'expr::hash::pkg_2const' => { desc => 'package $hash{const}{const}', - setup => 'our %h = (foo => { bar => 1 })', + setup => '%h = (foo => { bar => 1 })', code => '$h{foo}{bar}', }, 'expr::hash::pkg_2var' => { desc => 'package $hash{$k1}{$k2}', - setup => 'our ($k1,$k2) = qw(foo bar); our %h = ($k1 => { $k2 => 1 })', + setup => '($k1,$k2) = qw(foo bar); %h = ($k1 => { $k2 => 1 })', code => '$h{$k1}{$k2}', }, 'expr::hash::ref_pkg_2var' => { desc => 'package $hashref->{$k1}{$k2}', - setup => 'our ($k1,$k2) = qw(foo bar); our $r = {$k1 => { $k2 => 1 }}', + setup => '($k1,$k2) = qw(foo bar); $r = {$k1 => { $k2 => 1 }}', code => '$r->{$k1}{$k2}', }, 'expr::hash::ref_pkg_3const' => { desc => 'package $hashref->{const}{const}{const}', - setup => 'our $r = {foo => { bar => { baz => 1 }}}', + setup => '$r = {foo => { bar => { baz => 1 }}}', code => '$r->{foo}{bar}{baz}', }, 'expr::hash::ref_expr_pkg_3const' => { desc => '(package expr)->{const}{const}{const}', - setup => 'our $r = {foo => { bar => { baz => 1 }}}', - code => '($r//0)->{foo}{bar}{baz}', + setup => '$r = {foo => { bar => { baz => 1 }}}', + code => '($r||0)->{foo}{bar}{baz}', }, @@ -238,7 +238,7 @@ 'expr::index::utf8_position_1' => { desc => 'index of a utf8 string, matching at position 1', - setup => 'utf8::upgrade my $x = "abc"', + setup => 'my $x = "abc". chr(0x100); chop $x', code => 'index $x, "b"', }, -- Perl5 Master Repository
