In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/738155d2fb1d2430e97c38da93d074e4e8b5974f?hp=5ad999257778c656213e977c2fd782e515f02bad>
- Log ----------------------------------------------------------------- commit 738155d2fb1d2430e97c38da93d074e4e8b5974f Author: Father Chrysostomos <[email protected]> Date: Fri May 20 06:22:40 2016 -0700 [perl #128187] Forbid keys @_ in assigned lv sub This is a continuation of this commitâs great grandparent, extending the error to arrays. M lib/B/Op_private.pm M op.c M opcode.h M pp.c M regen/op_private M t/op/sub_lval.t commit 65985bd1d624ef3a5d827a74683c2bc1f24dfb96 Author: Father Chrysostomos <[email protected]> Date: Thu May 19 21:32:02 2016 -0700 toke: yylex comments Update; clarify; fix typo. M toke.c commit cc5f9b8acb940eaa010ae87bdf61c7c118da5bf7 Author: Father Chrysostomos <[email protected]> Date: Thu May 19 18:31:56 2016 -0700 Correct error msg for sub:lvalue{%h{k}} in sassign This: sub foo : lvalue { %hash{'key'} } foo = 3; was incorrectly giving âCan't modify key/value hash slice in list assignmentâ. There is no list assignment there. M pp.c M t/op/kvhslice.t commit a061ab0bf2cb11304132a96f31a2b0403912e9b6 Author: Father Chrysostomos <[email protected]> Date: Thu May 19 18:27:24 2016 -0700 [perl #128187] Forbid sub :lvalue{keys} in aassign This commit makes perl die when keys(%hash) is returned from an lvalue sub and the lvalue sub call is assigned to in list assignment: sub foo : lvalue { keys(%INC) } (foo) = 3; # death This prevents an assignment that is completely useless and probably a mistake, and it makes the lvalue-sub use of keys behave the same way as (keys(%INC)) = 3. M doop.c M t/op/sub_lval.t ----------------------------------------------------------------------- Summary of changes: doop.c | 7 +++++++ lib/B/Op_private.pm | 4 ++-- op.c | 1 + opcode.h | 8 ++++---- pp.c | 12 +++++++++++- regen/op_private | 3 ++- t/op/kvhslice.t | 8 ++++++-- t/op/sub_lval.t | 9 ++++++++- toke.c | 6 +++--- 9 files changed, 44 insertions(+), 14 deletions(-) diff --git a/doop.c b/doop.c index d290203..d2d64a4 100644 --- a/doop.c +++ b/doop.c @@ -1273,6 +1273,13 @@ Perl_do_kv(pTHX) RETURN; } + if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) { + const I32 flags = is_lvalue_sub(); + if (flags && !(flags & OPpENTERSUB_INARGS)) + /* diag_listed_as: Can't modify %s in %s */ + Perl_croak(aTHX_ "Can't modify keys in list assignment"); + } + /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */ assert(HvUSEDKEYS(keys) <= (SSize_t_MAX >> 1)); extend_size = (SSize_t)HvUSEDKEYS(keys) * (dokeys + dovalues); diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index ecacfaf..79a7e9e 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -136,7 +136,7 @@ $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref); $bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av r ... [18 chars truncated] $bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign); $bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign); -$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); +$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); $bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv); $bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray); $bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open); @@ -772,7 +772,7 @@ our %ops_using = ( OPpLVAL_DEFER => [qw(aelem helem multideref)], OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2 ... [17 chars truncated] OPpLVREF_ELEM => [qw(lvref refassign)], - OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], + OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)], OPpMULTIDEREF_DELETE => [qw(multideref)], OPpOFFBYONE => [qw(caller runcv wantarray)], diff --git a/op.c b/op.c index cad8237..e295dc2 100644 --- a/op.c +++ b/op.c @@ -2977,6 +2977,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags) break; case OP_KVHSLICE: case OP_KVASLICE: + case OP_AKEYS: if (type == OP_LEAVESUBLV) o->op_private |= OPpMAYBE_LVSUB; goto nomod; diff --git a/opcode.h b/opcode.h index 5ec8f58..26109e6 100644 --- a/opcode.h +++ b/opcode.h @@ -2557,7 +2557,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 96, /* aslice */ 99, /* kvaslice */ 0, /* aeach */ - 0, /* akeys */ + 39, /* akeys */ 0, /* avalues */ 0, /* each */ 0, /* values */ @@ -2826,7 +2826,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { */ EXTCONST U16 PL_op_private_bitdefs[] = { - 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i ... [628 chars truncated] + 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i ... [621 chars truncated] 0x2b5c, 0x3d59, /* pushmark */ 0x00bd, /* wantarray, runcv */ 0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */ @@ -2839,7 +2839,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 0x3819, /* pushre, match, qr, subst */ 0x2b5c, 0x19d8, 0x0256, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */ 0x2b5c, 0x3078, 0x0256, 0x3e04, 0x0003, /* rv2sv */ - 0x2c4c, 0x0003, /* av2arylen, pos, keys */ + 0x2c4c, 0x0003, /* av2arylen, pos, akeys, keys */ 0x2dbc, 0x0e18, 0x0b74, 0x028c, 0x3fc8, 0x3e04, 0x0003, /* rv2cv */ 0x012f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, rea ... [363 chars truncated] 0x325c, 0x3178, 0x2634, 0x2570, 0x0003, /* backtick */ @@ -3038,7 +3038,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* ASLICE */ (OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpLVAL_INTRO), /* KVASLICE */ (OPpMAYBE_LVSUB), /* AEACH */ (OPpARG1_MASK), - /* AKEYS */ (OPpARG1_MASK), + /* AKEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), /* AVALUES */ (OPpARG1_MASK), /* EACH */ (OPpARG1_MASK), /* VALUES */ (OPpARG1_MASK), diff --git a/pp.c b/pp.c index 5010065..9148286 100644 --- a/pp.c +++ b/pp.c @@ -4832,6 +4832,14 @@ PP(pp_akeys) PUSHi(av_tindex(array) + 1); } else if (gimme == G_ARRAY) { + if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) { + const I32 flags = is_lvalue_sub(); + if (flags && !(flags & OPpENTERSUB_INARGS)) + /* diag_listed_as: Can't modify %s in %s */ + Perl_croak(aTHX_ + "Can't modify keys on array in list assignment"); + } + { IV n = Perl_av_len(aTHX_ array); IV i; @@ -4848,6 +4856,7 @@ PP(pp_akeys) PUSHs(elem ? *elem : &PL_sv_undef); } } + } } RETURN; } @@ -5158,7 +5167,8 @@ PP(pp_kvhslice) if (flags) { if (!(flags & OPpENTERSUB_INARGS)) /* diag_listed_as: Can't modify %s in %s */ - Perl_croak(aTHX_ "Can't modify key/value hash slice in list assignment"); + Perl_croak(aTHX_ "Can't modify key/value hash slice in %s assignment", + GIMME_V == G_ARRAY ? "list" : "scalar"); lval = flags; } } diff --git a/regen/op_private b/regen/op_private index a7f569e..c8b9652 100644 --- a/regen/op_private +++ b/regen/op_private @@ -437,7 +437,8 @@ addbits($_, 6 => qw(OPpOUR_INTRO OURINTR)) # Variable was in an our() # We might be an lvalue to return addbits($_, 3 => qw(OPpMAYBE_LVSUB LVSUB)) for qw(aassign rv2av rv2gv rv2hv padav padhv aelem helem aslice hslice - av2arylen keys kvaslice kvhslice substr pos vec multideref); + av2arylen keys akeys kvaslice kvhslice substr pos vec + multideref); diff --git a/t/op/kvhslice.t b/t/op/kvhslice.t index 2bc6334..d054f42 100644 --- a/t/op/kvhslice.t +++ b/t/op/kvhslice.t @@ -8,7 +8,7 @@ BEGIN { # use strict; -plan tests => 39; +plan tests => 40; # simple use cases { @@ -134,9 +134,13 @@ plan tests => 39; # lvalue subs in assignment { local $@; - eval 'sub bar:lvalue{ %h{qw(a b)} }; bar() = "1"'; + eval 'sub bar:lvalue{ %h{qw(a b)} }; (bar) = "1"'; like $@, qr{^Can't modify key/value hash slice in list assignment}, 'not allowed as result of lvalue sub'; + eval 'sub bbar:lvalue{ %h{qw(a b)} }; bbar() = "1"'; + like $@, + qr{^Can't modify key/value hash slice in scalar assignment}, + 'not allowed as result of lvalue sub'; } } diff --git a/t/op/sub_lval.t b/t/op/sub_lval.t index d0bcdf0..dd0805f 100644 --- a/t/op/sub_lval.t +++ b/t/op/sub_lval.t @@ -5,7 +5,7 @@ BEGIN { @INC = '../lib'; require './test.pl'; } -plan tests=>209; +plan tests=>211; sub a : lvalue { my $a = 34; ${\(bless \$a)} } # Return a temporary sub b : lvalue { ${\shift} } @@ -553,6 +553,13 @@ sub keeze : lvalue { keys %__ } %__ = ("a","b"); keeze = 64; is scalar %__, '1/64', 'keys assignment through lvalue sub'; +eval { (keeze) = 64 }; +like $@, qr/^Can't modify keys in list assignment at /, + 'list assignment to keys through lv sub is forbidden'; +sub akeeze : lvalue { keys @_ } +eval { (akeeze) = 64 }; +like $@, qr/^Can't modify keys on array in list assignment at /, + 'list assignment to keys @_ through lv sub is forbidden'; # Bug 20001223.002: split thought that the list had only one element @ary = qw(4 5 6); diff --git a/toke.c b/toke.c index 4a20e61..5335400 100644 --- a/toke.c +++ b/toke.c @@ -4433,15 +4433,15 @@ S_check_scalar_slice(pTHX_ char *s) The type of the next token Structure: + Check if we have already built the token; if so, use it. Switch based on the current state: - - if we already built the token before, use it - if we have a case modifier in a string, deal with that - handle other cases of interpolation inside a string - scan the next line if we are inside a format - In the normal state switch on the next character: + In the normal state, switch on the next character: - default: if alphabetic, go to key lookup - unrecoginized character - croak + unrecognized character - croak - 0/4/26: handle end-of-line or EOF - cases for whitespace - \n and #: handle comments and line numbers -- Perl5 Master Repository
