Allow assignment to &CORE::keys()

8 files changed, 45 insertions, 31 deletions

diff --git a/doop.c b/doop.c
index dd9377ae92..ad9172ac1e 100644
--- a/doop.c
+++ b/doop.c
@@ -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 */
 
diff --git a/gv.c b/gv.c
index eef867dec8..4df3bce9dd 100644
--- a/gv.c
+++ b/gv.c
@@ -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;
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 95792adfa2..a65196b8a0 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 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);
@@ -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)],
diff --git a/op.c b/op.c
index d45a5a6808..c921c15e25 100644
--- a/op.c
+++ b/op.c
@@ -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)
diff --git a/opcode.h b/opcode.h
index 0a37dfcd4d..e4fc3ec1fe 100644
--- a/opcode.h
+++ b/opcode.h
@@ -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,
@@ -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 */
 
 };
@@ -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 */
@@ -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 */
@@ -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 */
 
@@ -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),
diff --git a/pp.c b/pp.c
index e0832f946f..17f31afac6 100644
--- a/pp.c
+++ b/pp.c
@@ -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);
@@ -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);
 }
 
diff --git a/regen/op_private b/regen/op_private
index bc50b89e1d..e291295cd0 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -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);
 
 
diff --git a/t/op/coreamp.t b/t/op/coreamp.t
index 9f85a2ae55..e35f4f3f34 100644
--- a/t/op/coreamp.t
+++ b/t/op/coreamp.t
@@ -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') {