Skip to content

Commit

Permalink
Allow assignment to &CORE::keys()
Browse files Browse the repository at this point in the history
  • Loading branch information
Father Chrysostomos committed May 21, 2016
1 parent bea284c commit cd64240
Show file tree
Hide file tree
Showing 8 changed files with 45 additions and 31 deletions.
4 changes: 2 additions & 2 deletions doop.c
View file
Expand Up @@ -1243,10 +1243,10 @@ Perl_do_kv(pTHX)
/* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */
const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS)
|| ( PL_op->op_type == OP_AVHVSWITCH
&& PL_op->op_private + OP_EACH == OP_KEYS );
&& (PL_op->op_private & 3) + OP_EACH == OP_KEYS );
const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES)
|| ( PL_op->op_type == OP_AVHVSWITCH
&& PL_op->op_private + OP_EACH == OP_VALUES );
&& (PL_op->op_private & 3) + OP_EACH == OP_VALUES );

(void)hv_iterinit(keys); /* always reset iterator regardless */

Expand Down
2 changes: 1 addition & 1 deletion gv.c
View file
Expand Up @@ -598,7 +598,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv,
)) != NULL) {
assert(GvCV(gv) == orig_cv);
if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS
&& opnum != OP_UNDEF)
&& opnum != OP_UNDEF && opnum != OP_KEYS)
CvLVALUE_off(cv); /* Now *that* was a neat trick. */
}
LEAVE;
Expand Down
4 changes: 2 additions & 2 deletions lib/B/Op_private.pm
View file
Expand Up @@ -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 rv2gv rv2hv rv2sv);
$bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign);
$bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign);
$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{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch 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);
Expand Down Expand Up @@ -778,7 +778,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 rv2gv rv2hv rv2sv)],
OPpLVREF_ELEM => [qw(lvref refassign)],
OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)],
OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch 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)],
Expand Down
5 changes: 5 additions & 0 deletions op.c
View file
Expand Up @@ -2981,6 +2981,11 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
if (type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
goto nomod;
case OP_AVHVSWITCH:
if (type == OP_LEAVESUBLV
&& (o->op_private & 3) + OP_EACH == OP_KEYS)
o->op_private |= OPpMAYBE_LVSUB;
goto nomod;
case OP_AV2ARYLEN:
PL_hints |= HINT_BLOCK_SCOPE;
if (type == OP_LEAVESUBLV)
Expand Down
46 changes: 24 additions & 22 deletions opcode.h
View file
Expand Up @@ -2406,6 +2406,7 @@ EXTCONST char PL_op_private_labels[] = {
EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
0, -1, -1,
0, 8, -1,
0, 8, -1,
0, 8, -1,
Expand Down Expand Up @@ -2802,17 +2803,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* once */
-1, /* custom */
181, /* coreargs */
0, /* avhvswitch */
185, /* avhvswitch */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
185, /* padrange */
187, /* refassign */
193, /* lvref */
199, /* lvrefslice */
200, /* lvavref */
187, /* padrange */
189, /* refassign */
195, /* lvref */
201, /* lvrefslice */
202, /* lvavref */
0, /* anonconst */

};
Expand All @@ -2832,22 +2833,22 @@ 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_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, avhvswitch, fc, anonconst */
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_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
0x2b5c, 0x3d59, /* pushmark */
0x00bd, /* wantarray, runcv */
0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */
0x2b5c, 0x3079, /* gvsv */
0x1655, /* gv */
0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
0x2b5c, 0x3d58, 0x0257, /* padsv */
0x2b5c, 0x3d58, 0x02b7, /* padsv */
0x2b5c, 0x3d58, 0x2c4c, 0x3a49, /* padav */
0x2b5c, 0x3d58, 0x0534, 0x05d0, 0x2c4c, 0x3a49, /* padhv */
0x3819, /* pushre, match, qr, subst */
0x2b5c, 0x19d8, 0x0256, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
0x2b5c, 0x3078, 0x0256, 0x3e04, 0x0003, /* rv2sv */
0x2b5c, 0x19d8, 0x02b6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
0x2b5c, 0x3078, 0x02b6, 0x3e04, 0x0003, /* rv2sv */
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, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
0x018f, /* 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, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
0x325c, 0x3178, 0x2634, 0x2570, 0x0003, /* backtick */
0x3818, 0x0003, /* substcont */
0x0f1c, 0x1f58, 0x0754, 0x3b8c, 0x22e8, 0x01e4, 0x0141, /* trans, transr */
Expand All @@ -2856,12 +2857,12 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x4070, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */
0x4070, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
0x12d8, 0x0067, /* repeat */
0x4070, 0x012f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
0x3570, 0x2c4c, 0x00cb, /* substr */
0x4070, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
0x3570, 0x2c4c, 0x012b, /* substr */
0x2c4c, 0x0067, /* vec */
0x2b5c, 0x3078, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2av */
0x01ff, /* aelemfast, aelemfast_lex */
0x2b5c, 0x2a58, 0x0256, 0x2c4c, 0x0067, /* aelem, helem */
0x025f, /* aelemfast, aelemfast_lex */
0x2b5c, 0x2a58, 0x02b6, 0x2c4c, 0x0067, /* aelem, helem */
0x2b5c, 0x2c4c, 0x3a49, /* aslice, hslice */
0x2c4d, /* kvaslice, kvhslice */
0x2b5c, 0x3998, 0x0003, /* delete */
Expand All @@ -2874,24 +2875,25 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x26cc, 0x0003, /* reverse */
0x28f8, 0x0003, /* flip, flop */
0x2b5c, 0x0003, /* cond_expr */
0x2b5c, 0x0e18, 0x0256, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
0x2b5c, 0x0e18, 0x02b6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
0x33d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
0x00bc, 0x012f, /* caller */
0x00bc, 0x018f, /* caller */
0x21f5, /* nextstate, dbstate */
0x29fc, 0x33d9, /* leave */
0x2b5c, 0x3078, 0x0e8c, 0x36e5, /* enteriter */
0x36e5, /* iter */
0x29fc, 0x0067, /* leaveloop */
0x41dc, 0x0003, /* last, next, redo, dump, goto */
0x325c, 0x3178, 0x2634, 0x2570, 0x012f, /* open */
0x325c, 0x3178, 0x2634, 0x2570, 0x018f, /* open */
0x1b90, 0x1dec, 0x1ca8, 0x1a64, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
0x1b90, 0x1dec, 0x1ca8, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
0x4071, /* wait, getppid, time */
0x3474, 0x0c30, 0x068c, 0x4148, 0x2104, 0x0003, /* entereval */
0x2d1c, 0x0018, 0x1144, 0x1061, /* coreargs */
0x2b5c, 0x019b, /* padrange */
0x2b5c, 0x3d58, 0x0376, 0x284c, 0x1748, 0x0067, /* refassign */
0x2b5c, 0x3d58, 0x0376, 0x284c, 0x1748, 0x0003, /* lvref */
0x2c4c, 0x00c7, /* avhvswitch */
0x2b5c, 0x01fb, /* padrange */
0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0067, /* refassign */
0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0003, /* lvref */
0x2b5d, /* lvrefslice */
0x2b5c, 0x3d58, 0x0003, /* lvavref */

Expand Down Expand Up @@ -3284,7 +3286,7 @@ EXTCONST U8 PL_op_private_valid[] = {
/* ONCE */ (OPpARG1_MASK),
/* CUSTOM */ (0xff),
/* COREARGS */ (OPpCOREARGS_DEREF1|OPpCOREARGS_DEREF2|OPpCOREARGS_SCALARMOD|OPpCOREARGS_PUSHMARK),
/* AVHVSWITCH */ (OPpARG1_MASK),
/* AVHVSWITCH */ (3|OPpMAYBE_LVSUB),
/* RUNCV */ (OPpOFFBYONE),
/* FC */ (OPpARG1_MASK),
/* PADCV */ (0),
Expand Down
4 changes: 2 additions & 2 deletions pp.c
View file
Expand Up @@ -4847,7 +4847,7 @@ PP(pp_akeys)

if ( PL_op->op_type == OP_AKEYS
|| ( PL_op->op_type == OP_AVHVSWITCH
&& PL_op->op_private + OP_AEACH == OP_AKEYS ))
&& (PL_op->op_private & 3) + OP_AEACH == OP_AKEYS ))
{
for (i = 0; i <= n; i++) {
mPUSHi(i);
Expand Down Expand Up @@ -6421,7 +6421,7 @@ PP(pp_avhvswitch)
dSP;
return PL_ppaddr[
(SvTYPE(TOPs) == SVt_PVAV ? OP_AEACH : OP_EACH)
+ PL_op->op_private
+ (PL_op->op_private & 3)
](aTHX);
}

Expand Down
2 changes: 1 addition & 1 deletion regen/op_private
View file
Expand Up @@ -437,7 +437,7 @@ 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 akeys kvaslice kvhslice substr pos vec
av2arylen keys akeys avhvswitch kvaslice kvhslice substr pos vec
multideref);


Expand Down
9 changes: 8 additions & 1 deletion t/op/coreamp.t
View file
Expand Up @@ -626,11 +626,18 @@ is &myjoin('a','b','c'), 'bac', '&join';
lis [&myjoin('a','b','c')], ['bac'], '&join in list context';

test_proto 'keys';
$tests += 4;
$tests += 6;
is &mykeys({ 1..4 }), 2, '&mykeys(\%hash) in scalar cx';
lis [sort &mykeys({1..4})], [1,3], '&mykeys(\%hash) in list cx';
is &mykeys([ 1..4 ]), 4, '&mykeys(\@array) in scalar cx';
lis [&mykeys([ 1..4 ])], [0..3], '&mykeys(\@array) in list cx';
{
my %h = 1..2;
&mykeys(\%h) = 1024;
like %h, qr|/1024\z|, '&mykeys = ...';
eval { (&mykeys(\%h)) = 1025; };
like $@, qr/^Can't modify keys in list assignment at /;
}

test_proto 'kill'; # set up mykill alias
if ($^O ne 'riscos') {
Expand Down

0 comments on commit cd64240

Please sign in to comment.