In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/cc0776d645a326dd0aaa2dbd8cd9b014c63723f5?hp=f92b68087fa16c181807b1e16f020d76b45c4274>
- Log ----------------------------------------------------------------- commit cc0776d645a326dd0aaa2dbd8cd9b014c63723f5 Author: Dagfinn Ilmari Mannsåker <[email protected]> Date: Sat May 20 14:08:06 2017 +0100 Add support for deleting key/value slices (RT#131328) ----------------------------------------------------------------------- Summary of changes: lib/B/Op_private.pm | 7 +- op.c | 8 +- opcode.h | 244 ++++++++++++++++++++++++++-------------------------- pod/perldata.pod | 11 ++- pod/perldiag.pod | 16 ++-- pp.c | 23 +++-- regen/op_private | 8 +- t/op/delete.t | 30 ++++++- t/op/kvaslice.t | 9 +- t/op/kvhslice.t | 9 +- 10 files changed, 201 insertions(+), 164 deletions(-) diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index f80cab3e88..09872cec30 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -294,7 +294,7 @@ $bits{cos}{0} = $bf[0]; $bits{dbmclose}{0} = $bf[0]; @{$bits{dbmopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{defined}{0} = $bf[0]; -@{$bits{delete}}{6,0} = ('OPpSLICE', $bf[0]); +@{$bits{delete}}{6,5,0} = ('OPpSLICE', 'OPpKVSLICE', $bf[0]); @{$bits{die}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{divide}}{1,0} = ($bf[1], $bf[1]); $bits{dofile}{0} = $bf[0]; @@ -631,6 +631,7 @@ our %defines = ( OPpHUSH_VMSISH => 32, OPpITER_DEF => 8, OPpITER_REVERSED => 2, + OPpKVSLICE => 32, OPpLIST_GUESSED => 64, OPpLVALUE => 128, OPpLVAL_DEFER => 64, @@ -728,6 +729,7 @@ our %labels = ( OPpHUSH_VMSISH => 'HUSH', OPpITER_DEF => 'DEF', OPpITER_REVERSED => 'REVERSED', + OPpKVSLICE => 'KVSLICE', OPpLIST_GUESSED => 'GUESSED', OPpLVALUE => 'LV', OPpLVAL_DEFER => 'LVDEFER', @@ -798,6 +800,7 @@ our %ops_using = ( OPpHUSH_VMSISH => [qw(dbstate nextstate)], OPpITER_DEF => [qw(enteriter)], OPpITER_REVERSED => [qw(enteriter iter)], + OPpKVSLICE => [qw(delete)], OPpLIST_GUESSED => [qw(list)], OPpLVALUE => [qw(leave leaveloop)], OPpLVAL_DEFER => [qw(aelem helem multideref)], @@ -814,7 +817,6 @@ our %ops_using = ( OPpREFCOUNTED => [qw(leave leaveeval leavesub leavesublv leavewrite)], OPpREPEAT_DOLIST => [qw(repeat)], OPpREVERSE_INPLACE => [qw(reverse)], - OPpSLICE => [qw(delete)], OPpSLICEWARNING => [qw(aslice hslice padav padhv rv2av rv2hv)], OPpSORT_DESCEND => [qw(sort)], OPpSPLIT_ASSIGN => [qw(split)], @@ -848,6 +850,7 @@ $ops_using{OPpMULTIDEREF_EXISTS} = $ops_using{OPpMULTIDEREF_DELETE}; $ops_using{OPpOPEN_IN_RAW} = $ops_using{OPpOPEN_IN_CRLF}; $ops_using{OPpOPEN_OUT_CRLF} = $ops_using{OPpOPEN_IN_CRLF}; $ops_using{OPpOPEN_OUT_RAW} = $ops_using{OPpOPEN_IN_CRLF}; +$ops_using{OPpSLICE} = $ops_using{OPpKVSLICE}; $ops_using{OPpSORT_INPLACE} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_INTEGER} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_NUMERIC} = $ops_using{OPpSORT_DESCEND}; diff --git a/op.c b/op.c index 51ffac2ac5..0b687e28bc 100644 --- a/op.c +++ b/op.c @@ -9773,11 +9773,11 @@ Perl_ck_delete(pTHX_ OP *o) case OP_HELEM: break; case OP_KVASLICE: - Perl_croak(aTHX_ "delete argument is index/value array slice," - " use array slice"); + o->op_flags |= OPf_SPECIAL; + /* FALLTHROUGH */ case OP_KVHSLICE: - Perl_croak(aTHX_ "delete argument is key/value hash slice, use" - " hash slice"); + o->op_private |= OPpKVSLICE; + break; default: Perl_croak(aTHX_ "delete argument is not a HASH or ARRAY " "element or slice"); diff --git a/opcode.h b/opcode.h index 5aec1a8ea3..8fd5e79fc2 100644 --- a/opcode.h +++ b/opcode.h @@ -2256,6 +2256,7 @@ END_EXTERN_C #define OPpEARLY_CV 0x20 #define OPpEVAL_RE_REPARSING 0x20 #define OPpHUSH_VMSISH 0x20 +#define OPpKVSLICE 0x20 #define OPpLVREF_HV 0x20 #define OPpMAY_RETURN_CONSTANT 0x20 #define OPpMULTIDEREF_DELETE 0x20 @@ -2372,6 +2373,7 @@ EXTCONST char PL_op_private_labels[] = { 'I','N','P','L','A','C','E','\0', 'I','N','T','\0', 'I','T','E','R','\0', + 'K','V','S','L','I','C','E','\0', 'L','E','X','\0', 'L','I','N','E','N','U','M','\0', 'L','V','\0', @@ -2426,14 +2428,14 @@ EXTCONST char PL_op_private_labels[] = { EXTCONST I16 PL_op_private_bitfields[] = { 0, 8, -1, 0, 8, -1, - 0, 539, -1, + 0, 547, -1, 0, 8, -1, 0, 8, -1, - 0, 546, -1, - 0, 535, -1, - 1, -1, 0, 512, 1, 33, 2, 283, -1, + 0, 554, -1, + 0, 543, -1, + 1, -1, 0, 520, 1, 33, 2, 283, -1, 4, -1, 1, 164, 2, 171, 3, 178, -1, - 4, -1, 0, 512, 1, 33, 2, 283, 3, 110, -1, + 4, -1, 0, 520, 1, 33, 2, 283, 3, 110, -1, }; @@ -2589,17 +2591,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* values */ 38, /* keys */ 97, /* delete */ - 100, /* exists */ - 102, /* rv2hv */ + 101, /* exists */ + 103, /* rv2hv */ 88, /* helem */ 93, /* hslice */ 96, /* kvhslice */ - 110, /* multideref */ + 111, /* multideref */ 47, /* unpack */ 47, /* pack */ - 117, /* split */ + 118, /* split */ 47, /* join */ - 122, /* list */ + 123, /* list */ 12, /* lslice */ 47, /* anonlist */ 47, /* anonhash */ @@ -2608,51 +2610,51 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* pop */ 0, /* shift */ 74, /* unshift */ - 124, /* sort */ - 131, /* reverse */ + 125, /* sort */ + 132, /* reverse */ 0, /* grepstart */ 0, /* grepwhile */ 0, /* mapstart */ 0, /* mapwhile */ 0, /* range */ - 133, /* flip */ - 133, /* flop */ + 134, /* flip */ + 134, /* flop */ 0, /* and */ 0, /* or */ 12, /* xor */ 0, /* dor */ - 135, /* cond_expr */ + 136, /* cond_expr */ 0, /* andassign */ 0, /* orassign */ 0, /* dorassign */ 0, /* method */ - 137, /* entersub */ - 144, /* leavesub */ - 144, /* leavesublv */ + 138, /* entersub */ + 145, /* leavesub */ + 145, /* leavesublv */ 0, /* argcheck */ - 146, /* argelem */ + 147, /* argelem */ 0, /* argdefelem */ - 148, /* caller */ + 149, /* caller */ 47, /* warn */ 47, /* die */ 47, /* reset */ -1, /* lineseq */ - 150, /* nextstate */ - 150, /* dbstate */ + 151, /* nextstate */ + 151, /* dbstate */ -1, /* unstack */ -1, /* enter */ - 151, /* leave */ + 152, /* leave */ -1, /* scope */ - 153, /* enteriter */ - 157, /* iter */ + 154, /* enteriter */ + 158, /* iter */ -1, /* enterloop */ - 158, /* leaveloop */ + 159, /* leaveloop */ -1, /* return */ - 160, /* last */ - 160, /* next */ - 160, /* redo */ - 160, /* dump */ - 160, /* goto */ + 161, /* last */ + 161, /* next */ + 161, /* redo */ + 161, /* dump */ + 161, /* goto */ 47, /* exit */ 0, /* method_named */ 0, /* method_super */ @@ -2664,7 +2666,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* leavewhen */ -1, /* break */ -1, /* continue */ - 162, /* open */ + 163, /* open */ 47, /* close */ 47, /* pipe_op */ 47, /* fileno */ @@ -2680,7 +2682,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 47, /* getc */ 47, /* read */ 47, /* enterwrite */ - 144, /* leavewrite */ + 145, /* leavewrite */ -1, /* prtf */ -1, /* print */ -1, /* say */ @@ -2710,33 +2712,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* getpeername */ 0, /* lstat */ 0, /* stat */ - 167, /* ftrread */ - 167, /* ftrwrite */ - 167, /* ftrexec */ - 167, /* fteread */ - 167, /* ftewrite */ - 167, /* fteexec */ - 172, /* ftis */ - 172, /* ftsize */ - 172, /* ftmtime */ - 172, /* ftatime */ - 172, /* ftctime */ - 172, /* ftrowned */ - 172, /* fteowned */ - 172, /* ftzero */ - 172, /* ftsock */ - 172, /* ftchr */ - 172, /* ftblk */ - 172, /* ftfile */ - 172, /* ftdir */ - 172, /* ftpipe */ - 172, /* ftsuid */ - 172, /* ftsgid */ - 172, /* ftsvtx */ - 172, /* ftlink */ - 172, /* fttty */ - 172, /* fttext */ - 172, /* ftbinary */ + 168, /* ftrread */ + 168, /* ftrwrite */ + 168, /* ftrexec */ + 168, /* fteread */ + 168, /* ftewrite */ + 168, /* fteexec */ + 173, /* ftis */ + 173, /* ftsize */ + 173, /* ftmtime */ + 173, /* ftatime */ + 173, /* ftctime */ + 173, /* ftrowned */ + 173, /* fteowned */ + 173, /* ftzero */ + 173, /* ftsock */ + 173, /* ftchr */ + 173, /* ftblk */ + 173, /* ftfile */ + 173, /* ftdir */ + 173, /* ftpipe */ + 173, /* ftsuid */ + 173, /* ftsgid */ + 173, /* ftsvtx */ + 173, /* ftlink */ + 173, /* fttty */ + 173, /* fttext */ + 173, /* ftbinary */ 74, /* chdir */ 74, /* chown */ 68, /* chroot */ @@ -2756,17 +2758,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* rewinddir */ 0, /* closedir */ -1, /* fork */ - 176, /* wait */ + 177, /* wait */ 74, /* waitpid */ 74, /* system */ 74, /* exec */ 74, /* kill */ - 176, /* getppid */ + 177, /* getppid */ 74, /* getpgrp */ 74, /* setpgrp */ 74, /* getpriority */ 74, /* setpriority */ - 176, /* time */ + 177, /* time */ -1, /* tms */ 0, /* localtime */ 47, /* gmtime */ @@ -2786,8 +2788,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* require */ 0, /* dofile */ -1, /* hintseval */ - 177, /* entereval */ - 144, /* leaveeval */ + 178, /* entereval */ + 145, /* leaveeval */ 0, /* entertry */ -1, /* leavetry */ 0, /* ghbyname */ @@ -2825,18 +2827,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* lock */ 0, /* once */ -1, /* custom */ - 183, /* coreargs */ - 187, /* avhvswitch */ + 184, /* coreargs */ + 188, /* avhvswitch */ 3, /* runcv */ 0, /* fc */ -1, /* padcv */ -1, /* introcv */ -1, /* clonecv */ - 189, /* padrange */ - 191, /* refassign */ - 197, /* lvref */ - 203, /* lvrefslice */ - 204, /* lvavref */ + 190, /* padrange */ + 192, /* refassign */ + 198, /* lvref */ + 204, /* lvrefslice */ + 205, /* lvavref */ 0, /* anonconst */ }; @@ -2857,67 +2859,67 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { EXTCONST U16 PL_op_private_bitdefs[] = { 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, ... [654 chars truncated] - 0x2cbc, 0x3df9, /* pushmark */ + 0x2dbc, 0x3ef9, /* pushmark */ 0x00bd, /* wantarray, runcv */ - 0x0498, 0x18d0, 0x3eac, 0x3968, 0x3085, /* const */ - 0x2cbc, 0x31d9, /* gvsv */ + 0x0498, 0x18d0, 0x3fac, 0x3a68, 0x3185, /* const */ + 0x2dbc, 0x32d9, /* gvsv */ 0x1735, /* 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, ... [14 chars truncated] - 0x2cbc, 0x3df8, 0x03d7, /* padsv */ - 0x2cbc, 0x3df8, 0x2dac, 0x3ae9, /* padav */ - 0x2cbc, 0x3df8, 0x0614, 0x06b0, 0x2dac, 0x3ae9, /* padhv */ - 0x2cbc, 0x1ab8, 0x03d6, 0x2dac, 0x2fa8, 0x3ea4, 0x0003, /* rv2gv */ - 0x2cbc, 0x31d8, 0x03d6, 0x3ea4, 0x0003, /* rv2sv */ - 0x2dac, 0x0003, /* av2arylen, pos, akeys, keys */ - 0x2f1c, 0x0ef8, 0x0c54, 0x028c, 0x4068, 0x3ea4, 0x0003, /* rv2cv */ + 0x2dbc, 0x3ef8, 0x03d7, /* padsv */ + 0x2dbc, 0x3ef8, 0x2eac, 0x3be9, /* padav */ + 0x2dbc, 0x3ef8, 0x0614, 0x06b0, 0x2eac, 0x3be9, /* padhv */ + 0x2dbc, 0x1ab8, 0x03d6, 0x2eac, 0x30a8, 0x3fa4, 0x0003, /* rv2gv */ + 0x2dbc, 0x32d8, 0x03d6, 0x3fa4, 0x0003, /* rv2sv */ + 0x2eac, 0x0003, /* av2arylen, pos, akeys, keys */ + 0x301c, 0x0ef8, 0x0c54, 0x028c, 0x4168, 0x3fa4, 0x0003, /* rv2cv */ 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, rea ... [363 chars truncated] - 0x33bc, 0x32d8, 0x2714, 0x2650, 0x0003, /* backtick */ - 0x0ffc, 0x2038, 0x0834, 0x3c2c, 0x23c8, 0x01e4, 0x0141, /* trans, transr */ + 0x34bc, 0x33d8, 0x2714, 0x2650, 0x0003, /* backtick */ + 0x0ffc, 0x2038, 0x0834, 0x3d2c, 0x23c8, 0x01e4, 0x0141, /* trans, transr */ 0x0e3c, 0x0538, 0x0067, /* sassign */ - 0x0af8, 0x09f4, 0x08f0, 0x2dac, 0x0067, /* aassign */ - 0x4110, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ - 0x4110, 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 */ + 0x0af8, 0x09f4, 0x08f0, 0x2eac, 0x0067, /* aassign */ + 0x4210, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, length, ord, chr, chroot, rmdir */ + 0x4210, 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 */ 0x13b8, 0x0067, /* repeat */ - 0x4110, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgr ... [46 chars truncated] - 0x36d0, 0x2dac, 0x012b, /* substr */ - 0x2dac, 0x0067, /* vec */ - 0x2cbc, 0x31d8, 0x2dac, 0x3ae8, 0x3ea4, 0x0003, /* rv2av */ + 0x4210, 0x018f, /* stringify, atan2, rand, srand, index, rindex, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgr ... [46 chars truncated] + 0x37d0, 0x2eac, 0x012b, /* substr */ + 0x2eac, 0x0067, /* vec */ + 0x2dbc, 0x32d8, 0x2eac, 0x3be8, 0x3fa4, 0x0003, /* rv2av */ 0x025f, /* aelemfast, aelemfast_lex */ - 0x2cbc, 0x2bb8, 0x03d6, 0x2dac, 0x0067, /* aelem, helem */ - 0x2cbc, 0x2dac, 0x3ae9, /* aslice, hslice */ - 0x2dad, /* kvaslice, kvhslice */ - 0x2cbc, 0x3a38, 0x0003, /* delete */ - 0x3f98, 0x0003, /* exists */ - 0x2cbc, 0x31d8, 0x0614, 0x06b0, 0x2dac, 0x3ae8, 0x3ea4, 0x0003, /* rv2hv */ - 0x2cbc, 0x2bb8, 0x1074, 0x19d0, 0x2dac, 0x3ea4, 0x0003, /* multideref */ - 0x2cbc, 0x31d8, 0x0350, 0x29cc, 0x2489, /* split */ - 0x2cbc, 0x20f9, /* list */ - 0x3d18, 0x3474, 0x1310, 0x27ac, 0x37c8, 0x28a4, 0x3141, /* sort */ + 0x2dbc, 0x2cb8, 0x03d6, 0x2eac, 0x0067, /* aelem, helem */ + 0x2dbc, 0x2eac, 0x3be9, /* aslice, hslice */ + 0x2ead, /* kvaslice, kvhslice */ + 0x2dbc, 0x3b38, 0x29d4, 0x0003, /* delete */ + 0x4098, 0x0003, /* exists */ + 0x2dbc, 0x32d8, 0x0614, 0x06b0, 0x2eac, 0x3be8, 0x3fa4, 0x0003, /* rv2hv */ + 0x2dbc, 0x2cb8, 0x1074, 0x19d0, 0x2eac, 0x3fa4, 0x0003, /* multideref */ + 0x2dbc, 0x32d8, 0x0350, 0x2acc, 0x2489, /* split */ + 0x2dbc, 0x20f9, /* list */ + 0x3e18, 0x3574, 0x1310, 0x27ac, 0x38c8, 0x28a4, 0x3241, /* sort */ 0x27ac, 0x0003, /* reverse */ - 0x2a58, 0x0003, /* flip, flop */ - 0x2cbc, 0x0003, /* cond_expr */ - 0x2cbc, 0x0ef8, 0x03d6, 0x028c, 0x4068, 0x3ea4, 0x2561, /* entersub */ - 0x3538, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ + 0x2b58, 0x0003, /* flip, flop */ + 0x2dbc, 0x0003, /* cond_expr */ + 0x2dbc, 0x0ef8, 0x03d6, 0x028c, 0x4168, 0x3fa4, 0x2561, /* entersub */ + 0x3638, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */ 0x02aa, 0x0003, /* argelem */ 0x00bc, 0x018f, /* caller */ 0x22d5, /* nextstate, dbstate */ - 0x2b5c, 0x3539, /* leave */ - 0x2cbc, 0x31d8, 0x0f6c, 0x3845, /* enteriter */ - 0x3845, /* iter */ - 0x2b5c, 0x0067, /* leaveloop */ - 0x427c, 0x0003, /* last, next, redo, dump, goto */ - 0x33bc, 0x32d8, 0x2714, 0x2650, 0x018f, /* open */ + 0x2c5c, 0x3639, /* leave */ + 0x2dbc, 0x32d8, 0x0f6c, 0x3945, /* enteriter */ + 0x3945, /* iter */ + 0x2c5c, 0x0067, /* leaveloop */ + 0x437c, 0x0003, /* last, next, redo, dump, goto */ + 0x34bc, 0x33d8, 0x2714, 0x2650, 0x018f, /* open */ 0x1c70, 0x1ecc, 0x1d88, 0x1b44, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */ 0x1c70, 0x1ecc, 0x1d88, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ... [12 chars truncated] - 0x4111, /* wait, getppid, time */ - 0x35d4, 0x0d10, 0x076c, 0x41e8, 0x21e4, 0x0003, /* entereval */ - 0x2e7c, 0x0018, 0x1224, 0x1141, /* coreargs */ - 0x2dac, 0x00c7, /* avhvswitch */ - 0x2cbc, 0x01fb, /* padrange */ - 0x2cbc, 0x3df8, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */ - 0x2cbc, 0x3df8, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */ - 0x2cbd, /* lvrefslice */ - 0x2cbc, 0x3df8, 0x0003, /* lvavref */ + 0x4211, /* wait, getppid, time */ + 0x36d4, 0x0d10, 0x076c, 0x42e8, 0x21e4, 0x0003, /* entereval */ + 0x2f7c, 0x0018, 0x1224, 0x1141, /* coreargs */ + 0x2eac, 0x00c7, /* avhvswitch */ + 0x2dbc, 0x01fb, /* padrange */ + 0x2dbc, 0x3ef8, 0x04f6, 0x292c, 0x1828, 0x0067, /* refassign */ + 0x2dbc, 0x3ef8, 0x04f6, 0x292c, 0x1828, 0x0003, /* lvref */ + 0x2dbd, /* lvrefslice */ + 0x2dbc, 0x3ef8, 0x0003, /* lvavref */ }; @@ -3072,7 +3074,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* EACH */ (OPpARG1_MASK), /* VALUES */ (OPpARG1_MASK), /* KEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), - /* DELETE */ (OPpARG1_MASK|OPpSLICE|OPpLVAL_INTRO), + /* DELETE */ (OPpARG1_MASK|OPpKVSLICE|OPpSLICE|OPpLVAL_INTRO), /* EXISTS */ (OPpARG1_MASK|OPpEXISTS_SUB), /* RV2HV */ (OPpARG1_MASK|OPpHINT_STRICT_REFS|OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpMAYBE_TRUEBOOL|OPpTRUEBOOL|OPpOUR_INTRO|OPpLVAL_INTRO), /* HELEM */ (OPpARG2_MASK|OPpMAYBE_LVSUB|OPpDEREF|OPpLVAL_DEFER|OPpLVAL_INTRO), diff --git a/pod/perldata.pod b/pod/perldata.pod index 37ead6bb79..3b43d258a0 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -1014,8 +1014,11 @@ returning a list of key/value pairs rather than just values: %h = (blonk => 2, foo => 3, squink => 5, bar => 8); %subset = %h{'foo', 'bar'}; # key/value hash slice # %subset is now (foo => 3, bar => 8) + %removed = delete %h{'foo', 'bar'}; + # %removed is now (foo => 3, bar => 8) + # %h is now (blonk => 2, squink => 5) -However, the result of such a slice cannot be localized, deleted or used +However, the result of such a slice cannot be localized or used in assignment. These are otherwise very much consistent with hash slices using the @ symbol. @@ -1028,6 +1031,12 @@ of index/value pairs: @a = "a".."z"; @list = %a[3,4,6]; # @list is now (3, "d", 4, "e", 6, "g") + @removed = delete %a[3,4,6] + # @removed is now (3, "d", 4, "e", 6, "g") + # @list[3,4,6] are now undef + +Note that calling L<C<delete>|perlfunc/delete EXPR> on array values is +strongly discouraged. =head2 Typeglobs and Filehandles X<typeglob> X<filehandle> X<*> diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 6108989109..31ace36725 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1940,17 +1940,6 @@ discovered. (F) You said something like "use Module 42" but in the Module file there are neither package declarations nor a C<$VERSION>. -=item delete argument is index/value array slice, use array slice - -(F) You used index/value array slice syntax (C<%array[...]>) as -the argument to C<delete>. You probably meant C<@array[...]> with -an @ symbol instead. - -=item delete argument is key/value hash slice, use hash slice - -(F) You used key/value hash slice syntax (C<%hash{...}>) as the argument to -C<delete>. You probably meant C<@hash{...}> with an @ symbol instead. - =item delete argument is not a HASH or ARRAY element or slice (F) The argument to C<delete> must be either a hash or array element, @@ -1964,6 +1953,11 @@ or a hash or array slice, such as: @foo[$bar, $baz, $xyzzy] @{$ref->[12]}{"susie", "queue"} +or a hash key/value or array index/value slice, such as: + + %foo[$bar, $baz, $xyzzy] + %{$ref->[12]}{"susie", "queue"} + =item Delimiter for here document is too long (F) In a here document construct like C<<<FOO>, the label C<FOO> is too diff --git a/pp.c b/pp.c index cc4cb59f7d..0c31062c3a 100644 --- a/pp.c +++ b/pp.c @@ -4985,20 +4985,33 @@ PP(pp_delete) gimme = GIMME_V; discard = (gimme == G_VOID) ? G_DISCARD : 0; - if (PL_op->op_private & OPpSLICE) { + if (PL_op->op_private & (OPpSLICE|OPpKVSLICE)) { dMARK; dORIGMARK; HV * const hv = MUTABLE_HV(POPs); const U32 hvtype = SvTYPE(hv); + int skip = 0; + if (PL_op->op_private & OPpKVSLICE) { + SSize_t items = SP - MARK; + + MEXTEND(SP,items); + while (items > 1) { + *(MARK+items*2-1) = *(MARK+items); + items--; + } + items = SP - MARK; + SP += items; + skip = 1; + } if (hvtype == SVt_PVHV) { /* hash element */ - while (++MARK <= SP) { - SV * const sv = hv_delete_ent(hv, *MARK, discard, 0); + while ((MARK += (1+skip)) <= SP) { + SV * const sv = hv_delete_ent(hv, *(MARK-skip), discard, 0); *MARK = sv ? sv : &PL_sv_undef; } } else if (hvtype == SVt_PVAV) { /* array element */ if (PL_op->op_flags & OPf_SPECIAL) { - while (++MARK <= SP) { - SV * const sv = av_delete(MUTABLE_AV(hv), SvIV(*MARK), discard); + while ((MARK += (1+skip)) <= SP) { + SV * const sv = av_delete(MUTABLE_AV(hv), SvIV(*(MARK-skip)), discard); *MARK = sv ? sv : &PL_sv_undef; } } diff --git a/regen/op_private b/regen/op_private index 5a8e714b5a..9d1ce6a5bd 100644 --- a/regen/op_private +++ b/regen/op_private @@ -644,9 +644,11 @@ addbits('list', 6 => qw(OPpLIST_GUESSED GUESSED)); -# Operating on a list of keys -addbits('delete', 6 => qw(OPpSLICE SLICE)); -# also 7 => OPpLVAL_INTRO, already defined above +addbits('delete', + 5 => qw(OPpKVSLICE KVSLICE), # Operating on a list of key/value pairs + 6 => qw(OPpSLICE SLICE ), # Operating on a list of keys + #7 => OPpLVAL_INTRO, already defined above +); diff --git a/t/op/delete.t b/t/op/delete.t index e7c1e87657..4e4299b871 100644 --- a/t/op/delete.t +++ b/t/op/delete.t @@ -6,7 +6,7 @@ BEGIN { set_up_inc( qw(. ../lib) ); } -plan( tests => 38 ); +plan( tests => 56 ); # delete() on hash elements @@ -15,6 +15,8 @@ $foo{2} = 'b'; $foo{3} = 'c'; $foo{4} = 'd'; $foo{5} = 'e'; +$foo{6} = 'f'; +$foo{7} = 'g'; $foo = delete $foo{2}; @@ -35,6 +37,18 @@ ok(!(exists $foo{5}),'e absent'); cmp_ok($foo{1},'eq','a','a still exists'); cmp_ok($foo{3},'eq','c','c still exists'); +@foo = delete %foo{6,7}; + +cmp_ok(scalar(@foo),'==',4,'deleted kvslice'); +cmp_ok($foo[0],'eq','6','slice k1'); +cmp_ok($foo[1],'eq','f','slice v1'); +cmp_ok($foo[2],'eq','7','slice k2'); +cmp_ok($foo[3],'eq','g','slice v2'); +ok(!(exists $foo{5}),'f absent'); +ok(!(exists $foo{6}),'g absent'); +cmp_ok($foo{1},'eq','a','a still exists'); +cmp_ok($foo{3},'eq','c','c still exists'); + $foo = join('',values(%foo)); ok($foo eq 'ac' || $foo eq 'ca','remaining keys'); @@ -73,6 +87,8 @@ $foo[2] = 'b'; $foo[3] = 'c'; $foo[4] = 'd'; $foo[5] = 'e'; +$foo[6] = 'f'; +$foo[7] = 'g'; $foo = delete $foo[2]; @@ -93,6 +109,18 @@ ok(!(exists $foo[5]),'ary e absent'); cmp_ok($foo[1],'eq','a','ary a still exists'); cmp_ok($foo[3],'eq','c','ary c still exists'); +@bar = delete %foo[6,7]; + +cmp_ok(scalar(@bar),'==',4,'deleted kvslice'); +cmp_ok($bar[0],'eq','6','slice k1'); +cmp_ok($bar[1],'eq','f','slice v1'); +cmp_ok($bar[2],'eq','7','slice k2'); +cmp_ok($bar[3],'eq','g','slice v2'); +ok(!(exists $bar[5]),'f absent'); +ok(!(exists $bar[6]),'g absent'); +cmp_ok($foo[1],'eq','a','a still exists'); +cmp_ok($foo[3],'eq','c','c still exists'); + $foo = join('',@foo); cmp_ok($foo,'eq','ac','ary elems'); cmp_ok(scalar(@foo),'==',4,'four is the number thou shalt count'); diff --git a/t/op/kvaslice.t b/t/op/kvaslice.t index aec9a97801..29cd8acf0e 100644 --- a/t/op/kvaslice.t +++ b/t/op/kvaslice.t @@ -8,7 +8,7 @@ BEGIN { # use strict; -plan tests => 39; +plan tests => 38; # simple use cases { @@ -120,13 +120,6 @@ plan tests => 39; like $@, qr{^Can't modify index/value array slice in local at}, 'local dies'; } - # no delete - { - local $@; - eval 'delete %a[1,2]'; - like $@, qr{^delete argument is index/value array slice, use array slice}, - 'delete dies'; - } # no assign { local $@; diff --git a/t/op/kvhslice.t b/t/op/kvhslice.t index d054f4230a..e3309ef3e9 100644 --- a/t/op/kvhslice.t +++ b/t/op/kvhslice.t @@ -8,7 +8,7 @@ BEGIN { # use strict; -plan tests => 40; +plan tests => 39; # simple use cases { @@ -117,13 +117,6 @@ plan tests => 40; like $@, qr{^Can't modify key/value hash slice in local at}, 'local dies'; } - # no delete - { - local $@; - eval 'delete %h{qw(a b)}'; - like $@, qr{^delete argument is key/value hash slice, use hash slice}, - 'delete dies'; - } # no assign { local $@; -- Perl5 Master Repository
