In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/ffd2521e4c1de43a59187823fbf6e3aedeab5433?hp=5ea3460bf04be858ac65dd690c9f49c3d1514ea4>
- Log ----------------------------------------------------------------- commit ffd2521e4c1de43a59187823fbf6e3aedeab5433 Merge: 5ea3460 09783a0 Author: Father Chrysostomos <[email protected]> Date: Fri May 20 22:14:08 2016 -0700 [Merge] &CORE::foo() calls with keys, push, etc. The hash and array functions, keys, each, values, push, pop, shift, unshift and splice, can now be called with ampersand syntax and via reference. commit 09783a0a55f86092ea742bd6915170b04f98af7f Author: Father Chrysostomos <[email protected]> Date: Fri May 20 21:57:32 2016 -0700 Update CORE.pod to reflect &CORE::keys() etc. M lib/CORE.pod commit cd642408b70f009ca99d93c350a0bfc33707da9a Author: Father Chrysostomos <[email protected]> Date: Fri May 20 17:50:23 2016 -0700 Allow assignment to &CORE::keys() M doop.c M gv.c M lib/B/Op_private.pm M op.c M opcode.h M pp.c M regen/op_private M t/op/coreamp.t commit bea284c81588d5800ea7246f6a409ab0599e57e5 Author: Father Chrysostomos <[email protected]> Date: Tue May 17 00:27:30 2016 -0700 Allow &CORE::foo() with array functions M gv.c M pp.c M t/op/coreamp.t commit 01bbc29fd9fddea39dc7b8194ad3cd950f7a466e Author: Father Chrysostomos <[email protected]> Date: Mon May 16 23:32:06 2016 -0700 perldiag: Document unknown OA_* panic M pod/perldiag.pod commit f7ce57d8b7fc8923088cd227564909509cc7f9bf Author: Father Chrysostomos <[email protected]> Date: Fri May 20 22:13:15 2016 -0700 f M t/op/coreamp.t commit 73665bc485938167ff7ce1082176b6dac0df99de Author: Father Chrysostomos <[email protected]> Date: Mon May 16 23:10:17 2016 -0700 Allow &CORE::foo() with hash functions &CORE::keys does not yet work as an lvalue. (Iâm not sure how to make that work.) M doop.c M gv.c M lib/B/Op_private.pm M op.c M pp.c M regen/op_private M t/op/coreamp.t commit 81477935a7844157c487842db13847814f93b52a Author: Father Chrysostomos <[email protected]> Date: Mon May 16 18:16:28 2016 -0700 Increase $Opcode::VERSION to 1.35 M ext/Opcode/Opcode.pm commit 881018827f9961cf5132d9243259ca1e9e2c0330 Author: Father Chrysostomos <[email protected]> Date: Mon May 16 18:15:42 2016 -0700 Add avhvswitch op &CORE::keys() et al. will use this to switch between keys and akeys depending on the argument type. M ext/Opcode/Opcode.pm M lib/B/Op_private.pm M opcode.h M opnames.h M pp.c M pp_proto.h M regen/opcodes commit d88ca568f0ba6af079816962f37e415fd773f90e Author: Father Chrysostomos <[email protected]> Date: Mon May 16 18:09:02 2016 -0700 regen/opcodes: Re-order aeach, akeys, and avalues In a forthcoming commit, I will need them to be in the same order as the corresponding hash functions. M opcode.h M opnames.h M regen/opcodes commit 29e10d39e1747dbb4f219bc660ccfa99ff864ee8 Author: Father Chrysostomos <[email protected]> Date: Sun May 15 13:59:24 2016 -0700 pp.c: Use PL_op_desc in pp_coreargs OP_DESC is inconvienient here, because it expects an op, not an op number, so we have to follow pointers to find an appropriate op. It is also needlessly expensive, since we do not need to check for custom ops in pp_coreargs (which OP_DESC does). Just access the underlying array directly. M pp.c ----------------------------------------------------------------------- Summary of changes: doop.c | 8 +- ext/Opcode/Opcode.pm | 4 +- gv.c | 12 +-- lib/B/Op_private.pm | 228 ++++++++++++++++++++++++++------------------------- lib/CORE.pod | 6 +- op.c | 11 +++ opcode.h | 61 ++++++++------ opnames.h | 29 +++---- pod/perldiag.pod | 6 ++ pp.c | 67 ++++++++++++--- pp_proto.h | 1 + regen/op_private | 8 +- regen/opcodes | 3 +- t/op/coreamp.t | 160 ++++++++++++++++++++++++++++++++++++ 14 files changed, 422 insertions(+), 182 deletions(-) diff --git a/doop.c b/doop.c index d2d64a4..ad9172a 100644 --- a/doop.c +++ b/doop.c @@ -1241,8 +1241,12 @@ Perl_do_kv(pTHX) const U8 gimme = GIMME_V; const I32 dokv = (PL_op->op_type == OP_RV2HV || PL_op->op_type == OP_PADHV); /* op_type is OP_RKEYS/OP_RVALUES if pp_rkeys delegated to here */ - const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS); - const I32 dovalues = dokv || (PL_op->op_type == OP_VALUES); + const I32 dokeys = dokv || (PL_op->op_type == OP_KEYS) + || ( PL_op->op_type == OP_AVHVSWITCH + && (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 & 3) + OP_EACH == OP_VALUES ); (void)hv_iterinit(keys); /* always reset iterator regardless */ diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 1522c4c..9d667c2 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.34"; +$VERSION = "1.35"; use Carp; use Exporter (); @@ -338,7 +338,7 @@ invert_opset function. warn die lineseq nextstate scope enter leave - rv2cv anoncode prototype coreargs anonconst + rv2cv anoncode prototype coreargs avhvswitch anonconst entersub leavesub leavesublv return method method_named method_super method_redir method_redir_super diff --git a/gv.c b/gv.c index e4fb3fe..4df3bce 100644 --- a/gv.c +++ b/gv.c @@ -531,18 +531,12 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, return NULL; case KEY_chdir: case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete: - case KEY_each : case KEY_eof : case KEY_exec : case KEY_exists: - case KEY_keys: + case KEY_eof : case KEY_exec: case KEY_exists : case KEY_lstat: - case KEY_pop: - case KEY_push: - case KEY_shift: - case KEY_splice: case KEY_split: + case KEY_split: case KEY_stat: case KEY_system: case KEY_truncate: case KEY_unlink: - case KEY_unshift: - case KEY_values: ampable = FALSE; } if (!gv) { @@ -604,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 79a7e9e..a65196b 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 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); @@ -175,6 +175,11 @@ my @bf = ( bitmask => 3, }, { + bitmin => 0, + bitmax => 1, + bitmask => 3, + }, + { label => '-', mask_def => 'OPpARG3_MASK', bitmin => 0, @@ -229,52 +234,53 @@ my @bf = ( @{$bits{aassign}}{6,5,4,1,0} = ('OPpASSIGN_COMMON_SCALAR', 'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', $bf[1], $bf[1]); $bits{abs}{0} = $bf[0]; -@{$bits{accept}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{accept}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{add}}{1,0} = ($bf[1], $bf[1]); $bits{aeach}{0} = $bf[0]; -@{$bits{aelem}}{5,4,1,0} = ($bf[6], $bf[6], $bf[1], $bf[1]); -@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); -@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); +@{$bits{aelem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); +@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]); +@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]); $bits{akeys}{0} = $bf[0]; $bits{alarm}{0} = $bf[0]; $bits{and}{0} = $bf[0]; $bits{andassign}{0} = $bf[0]; $bits{anonconst}{0} = $bf[0]; -@{$bits{anonhash}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{anonlist}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{atan2}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{anonhash}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{anonlist}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{atan2}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{av2arylen}{0} = $bf[0]; $bits{avalues}{0} = $bf[0]; +@{$bits{avhvswitch}}{1,0} = ($bf[2], $bf[2]); $bits{backtick}{0} = $bf[0]; -@{$bits{bind}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{binmode}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{bind}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{binmode}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{bit_and}}{1,0} = ($bf[1], $bf[1]); @{$bits{bit_or}}{1,0} = ($bf[1], $bf[1]); @{$bits{bit_xor}}{1,0} = ($bf[1], $bf[1]); -@{$bits{bless}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{caller}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{chdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{chmod}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{bless}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{caller}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{chdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{chmod}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{chomp}{0} = $bf[0]; $bits{chop}{0} = $bf[0]; -@{$bits{chown}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{chown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{chr}{0} = $bf[0]; $bits{chroot}{0} = $bf[0]; -@{$bits{close}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{close}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{closedir}{0} = $bf[0]; $bits{complement}{0} = $bf[0]; @{$bits{concat}}{1,0} = ($bf[1], $bf[1]); $bits{cond_expr}{0} = $bf[0]; -@{$bits{connect}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{connect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{const}}{6,4,3,2,1} = ('OPpCONST_BARE', 'OPpCONST_ENTERED', 'OPpCONST_STRICT', 'OPpCONST_SHORTCIRCUIT', 'OPpCONST_NOVER'); @{$bits{coreargs}}{7,6,1,0} = ('OPpCOREARGS_PUSHMARK', 'OPpCOREARGS_SCALARMOD', 'OPpCOREARGS_DEREF2', 'OPpCOREARGS_DEREF1'); $bits{cos}{0} = $bf[0]; -@{$bits{crypt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{crypt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{dbmclose}{0} = $bf[0]; -@{$bits{dbmopen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$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{die}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$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]; $bits{dor}{0} = $bf[0]; @@ -284,23 +290,23 @@ $bits{each}{0} = $bf[0]; @{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]); $bits{entergiven}{0} = $bf[0]; $bits{enteriter}{3} = 'OPpITER_DEF'; -@{$bits{entersub}}{5,4,0} = ($bf[6], $bf[6], 'OPpENTERSUB_INARGS'); +@{$bits{entersub}}{5,4,0} = ($bf[7], $bf[7], 'OPpENTERSUB_INARGS'); $bits{entertry}{0} = $bf[0]; $bits{enterwhen}{0} = $bf[0]; -@{$bits{enterwrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{eof}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{enterwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{eof}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{eq}}{1,0} = ($bf[1], $bf[1]); -@{$bits{exec}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{exec}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{exists}}{6,0} = ('OPpEXISTS_SUB', $bf[0]); -@{$bits{exit}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{exit}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{exp}{0} = $bf[0]; $bits{fc}{0} = $bf[0]; -@{$bits{fcntl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{fileno}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{fcntl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{fileno}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{flip}{0} = $bf[0]; -@{$bits{flock}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{flock}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{flop}{0} = $bf[0]; -@{$bits{formline}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{formline}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{ftatime}{0} = $bf[0]; $bits{ftbinary}{0} = $bf[0]; $bits{ftblk}{0} = $bf[0]; @@ -330,32 +336,32 @@ $bits{fttty}{0} = $bf[0]; $bits{ftzero}{0} = $bf[0]; @{$bits{ge}}{1,0} = ($bf[1], $bf[1]); @{$bits{gelem}}{1,0} = ($bf[1], $bf[1]); -@{$bits{getc}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{getc}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{getpeername}{0} = $bf[0]; -@{$bits{getpgrp}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{getpriority}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{getpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{getpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{getsockname}{0} = $bf[0]; $bits{ggrgid}{0} = $bf[0]; $bits{ggrnam}{0} = $bf[0]; -@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{ghbyname}{0} = $bf[0]; -@{$bits{glob}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gmtime}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{glob}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gmtime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{gnbyname}{0} = $bf[0]; $bits{goto}{0} = $bf[0]; $bits{gpbyname}{0} = $bf[0]; -@{$bits{gpbynumber}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{gpbynumber}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{gpwnam}{0} = $bf[0]; $bits{gpwuid}{0} = $bf[0]; $bits{grepstart}{0} = $bf[0]; $bits{grepwhile}{0} = $bf[0]; -@{$bits{gsbyname}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gsbyport}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gsockopt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{gsbyname}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gsbyport}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gsockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{gt}}{1,0} = ($bf[1], $bf[1]); $bits{gv}{5} = 'OPpEARLY_CV'; -@{$bits{helem}}{5,4,1,0} = ($bf[6], $bf[6], $bf[1], $bf[1]); +@{$bits{helem}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); $bits{hex}{0} = $bf[0]; @{$bits{i_add}}{1,0} = ($bf[1], $bf[1]); @{$bits{i_divide}}{1,0} = ($bf[1], $bf[1]); @@ -374,12 +380,12 @@ $bits{i_postinc}{0} = $bf[0]; $bits{i_predec}{0} = $bf[0]; $bits{i_preinc}{0} = $bf[0]; @{$bits{i_subtract}}{1,0} = ($bf[1], $bf[1]); -@{$bits{index}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{index}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{int}{0} = $bf[0]; -@{$bits{ioctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{join}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{keys}{0} = $bf[0]; -@{$bits{kill}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{kill}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{last}{0} = $bf[0]; $bits{lc}{0} = $bf[0]; $bits{lcfirst}{0} = $bf[0]; @@ -393,9 +399,9 @@ $bits{leavewhen}{0} = $bf[0]; $bits{leavewrite}{0} = $bf[0]; @{$bits{left_shift}}{1,0} = ($bf[1], $bf[1]); $bits{length}{0} = $bf[0]; -@{$bits{link}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{link}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{list}{6} = 'OPpLIST_GUESSED'; -@{$bits{listen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{listen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{localtime}{0} = $bf[0]; $bits{lock}{0} = $bf[0]; $bits{log}{0} = $bf[0]; @@ -403,7 +409,7 @@ $bits{log}{0} = $bf[0]; $bits{lstat}{0} = $bf[0]; @{$bits{lt}}{1,0} = ($bf[1], $bf[1]); $bits{lvavref}{0} = $bf[0]; -@{$bits{lvref}}{5,4,0} = ($bf[7], $bf[7], $bf[0]); +@{$bits{lvref}}{5,4,0} = ($bf[8], $bf[8], $bf[0]); $bits{mapstart}{0} = $bf[0]; $bits{mapwhile}{0} = $bf[0]; $bits{method}{0} = $bf[0]; @@ -411,12 +417,12 @@ $bits{method_named}{0} = $bf[0]; $bits{method_redir}{0} = $bf[0]; $bits{method_redir_super}{0} = $bf[0]; $bits{method_super}{0} = $bf[0]; -@{$bits{mkdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{mkdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{modulo}}{1,0} = ($bf[1], $bf[1]); -@{$bits{msgctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgrcv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgsnd}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{msgctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgrcv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgsnd}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{multideref}}{5,4,0} = ('OPpMULTIDEREF_DELETE', 'OPpMULTIDEREF_EXISTS', $bf[0]); @{$bits{multiply}}{1,0} = ($bf[1], $bf[1]); @{$bits{nbit_and}}{1,0} = ($bf[1], $bf[1]); @@ -430,15 +436,15 @@ $bits{next}{0} = $bf[0]; $bits{not}{0} = $bf[0]; $bits{oct}{0} = $bf[0]; $bits{once}{0} = $bf[0]; -@{$bits{open}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{open_dir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{open}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{open_dir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{or}{0} = $bf[0]; $bits{orassign}{0} = $bf[0]; $bits{ord}{0} = $bf[0]; -@{$bits{pack}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4], $bf[4], $bf[4], $bf[4]); -@{$bits{padsv}}{5,4} = ($bf[6], $bf[6]); -@{$bits{pipe_op}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{pack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); +@{$bits{padsv}}{5,4} = ($bf[7], $bf[7]); +@{$bits{pipe_op}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{pop}{0} = $bf[0]; $bits{pos}{0} = $bf[0]; $bits{postdec}{0} = $bf[0]; @@ -447,36 +453,36 @@ $bits{postinc}{0} = $bf[0]; $bits{predec}{0} = $bf[0]; $bits{preinc}{0} = $bf[0]; $bits{prototype}{0} = $bf[0]; -@{$bits{push}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{push}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{quotemeta}{0} = $bf[0]; -@{$bits{rand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{range}{0} = $bf[0]; -@{$bits{read}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{read}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{readdir}{0} = $bf[0]; $bits{readline}{0} = $bf[0]; $bits{readlink}{0} = $bf[0]; -@{$bits{recv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{recv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{redo}{0} = $bf[0]; $bits{ref}{0} = $bf[0]; -@{$bits{refassign}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); +@{$bits{refassign}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]); $bits{refgen}{0} = $bf[0]; $bits{regcmaybe}{0} = $bf[0]; $bits{regcomp}{0} = $bf[0]; $bits{regcreset}{0} = $bf[0]; -@{$bits{rename}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rename}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{repeat}}{6,1,0} = ('OPpREPEAT_DOLIST', $bf[1], $bf[1]); $bits{require}{0} = $bf[0]; -@{$bits{reset}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{reset}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{reverse}}{3,0} = ('OPpREVERSE_INPLACE', $bf[0]); $bits{rewinddir}{0} = $bf[0]; @{$bits{right_shift}}{1,0} = ($bf[1], $bf[1]); -@{$bits{rindex}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rindex}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{rmdir}{0} = $bf[0]; $bits{rv2av}{0} = $bf[0]; @{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT', $bf[0]); -@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[6], $bf[6], 'OPpDONT_INIT_GV', $bf[0]); +@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[7], $bf[7], 'OPpDONT_INIT_GV', $bf[0]); $bits{rv2hv}{0} = $bf[0]; -@{$bits{rv2sv}}{5,4,0} = ($bf[6], $bf[6], $bf[0]); +@{$bits{rv2sv}}{5,4,0} = ($bf[7], $bf[7], $bf[0]); @{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS', $bf[1], $bf[1]); @{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]); @{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]); @@ -486,76 +492,76 @@ $bits{schomp}{0} = $bf[0]; $bits{schop}{0} = $bf[0]; @{$bits{scmp}}{1,0} = ($bf[1], $bf[1]); $bits{scomplement}{0} = $bf[0]; -@{$bits{seek}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{seekdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{select}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semop}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{send}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{seek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{seekdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{select}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semop}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{send}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{seq}}{1,0} = ($bf[1], $bf[1]); -@{$bits{setpgrp}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{setpriority}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{setpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{setpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sge}}{1,0} = ($bf[1], $bf[1]); @{$bits{sgt}}{1,0} = ($bf[1], $bf[1]); $bits{shift}{0} = $bf[0]; -@{$bits{shmctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmread}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmwrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{shmctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{shostent}{0} = $bf[0]; -@{$bits{shutdown}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{shutdown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sin}{0} = $bf[0]; @{$bits{sle}}{1,0} = ($bf[1], $bf[1]); -@{$bits{sleep}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sleep}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{slt}}{1,0} = ($bf[1], $bf[1]); @{$bits{smartmatch}}{1,0} = ($bf[1], $bf[1]); @{$bits{sne}}{1,0} = ($bf[1], $bf[1]); $bits{snetent}{0} = $bf[0]; -@{$bits{socket}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sockpair}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{socket}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sort}}{6,5,4,3,2,1,0} = ('OPpSORT_STABLE', 'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC'); -@{$bits{splice}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{split}{7} = 'OPpSPLIT_IMPLIM'; -@{$bits{sprintf}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sprotoent}{0} = $bf[0]; $bits{sqrt}{0} = $bf[0]; -@{$bits{srand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{srand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{srefgen}{0} = $bf[0]; -@{$bits{sselect}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sselect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sservent}{0} = $bf[0]; -@{$bits{ssockopt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ssockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{stat}{0} = $bf[0]; -@{$bits{stringify}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{stringify}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{study}{0} = $bf[0]; $bits{substcont}{0} = $bf[0]; -@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[2], $bf[2], $bf[2]); +@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[3], $bf[3], $bf[3]); @{$bits{subtract}}{1,0} = ($bf[1], $bf[1]); -@{$bits{symlink}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{syscall}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysopen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysread}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysseek}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{system}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{syswrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{tell}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{symlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{syscall}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysseek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{system}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{syswrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{tell}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{telldir}{0} = $bf[0]; -@{$bits{tie}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{tie}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{tied}{0} = $bf[0]; -@{$bits{truncate}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{truncate}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{uc}{0} = $bf[0]; $bits{ucfirst}{0} = $bf[0]; -@{$bits{umask}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{umask}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{undef}{0} = $bf[0]; -@{$bits{unlink}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{unpack}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{unshift}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{unlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{unpack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{unshift}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{untie}{0} = $bf[0]; -@{$bits{utime}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{utime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{values}{0} = $bf[0]; @{$bits{vec}}{1,0} = ($bf[1], $bf[1]); -@{$bits{waitpid}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{warn}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{waitpid}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{warn}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{xor}}{1,0} = ($bf[1], $bf[1]); @@ -772,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 rv2 ... [17 chars truncated] 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/lib/CORE.pod b/lib/CORE.pod index ce5feb5..e40b2d0 100644 --- a/lib/CORE.pod +++ b/lib/CORE.pod @@ -49,10 +49,8 @@ ampersand syntax and through references does not work for the following functions, as they have special syntax that cannot always be translated into a simple list (e.g., C<eof> vs C<eof()>): -C<chdir>, C<chomp>, C<chop>, C<defined>, C<delete>, C<each>, -C<eof>, C<exec>, C<exists>, C<keys>, C<lstat>, C<pop>, C<push>, -C<shift>, C<splice>, C<split>, C<stat>, C<system>, C<truncate>, -C<unlink>, C<unshift>, C<values> +C<chdir>, C<chomp>, C<chop>, C<defined>, C<delete>, C<eof>, C<exec>, +C<exists>, C<lstat>, C<split>, C<stat>, C<system>, C<truncate>, C<unlink> =head1 OVERRIDING CORE FUNCTIONS diff --git a/op.c b/op.c index e295dc2..c921c15 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) @@ -14689,6 +14694,12 @@ Perl_coresub_op(pTHX_ SV * const coreargssv, const int code, newOP(OP_CALLER,0) ) ); + case OP_EACH: + case OP_KEYS: + case OP_VALUES: + o = newUNOP(OP_AVHVSWITCH,0,argop); + o->op_private = opnum-OP_EACH; + return o; case OP_SELECT: /* which represents OP_SSELECT as well */ if (code) return newCONDOP( diff --git a/opcode.h b/opcode.h index 26109e6..e4fc3ec 100644 --- a/opcode.h +++ b/opcode.h @@ -288,8 +288,8 @@ EXTCONST char* const PL_op_name[] = { "aslice", "kvaslice", "aeach", - "akeys", "avalues", + "akeys", "each", "values", "keys", @@ -528,6 +528,7 @@ EXTCONST char* const PL_op_name[] = { "once", "custom", "coreargs", + "avhvswitch", "runcv", "fc", "padcv", @@ -689,8 +690,8 @@ EXTCONST char* const PL_op_desc[] = { "array slice", "index/value array slice", "each on array", - "keys on array", "values on array", + "keys on array", "each", "values", "keys", @@ -929,6 +930,7 @@ EXTCONST char* const PL_op_desc[] = { "once", "unknown custom operator", "CORE:: subroutine", + "Array/hash switch", "__SUB__", "fc", "private subroutine", @@ -1104,8 +1106,8 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_aslice, Perl_pp_kvaslice, Perl_pp_aeach, - Perl_pp_akeys, Perl_pp_avalues, /* implemented by Perl_pp_akeys */ + Perl_pp_akeys, Perl_pp_each, Perl_pp_values, /* implemented by Perl_do_kv */ Perl_pp_keys, /* implemented by Perl_do_kv */ @@ -1344,6 +1346,7 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */ Perl_pp_once, Perl_pp_custom, /* implemented by Perl_unimplemented_op */ Perl_pp_coreargs, + Perl_pp_avhvswitch, Perl_pp_runcv, Perl_pp_fc, Perl_pp_padcv, @@ -1515,8 +1518,8 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* aslice */ Perl_ck_null, /* kvaslice */ Perl_ck_each, /* aeach */ - Perl_ck_each, /* akeys */ Perl_ck_each, /* avalues */ + Perl_ck_each, /* akeys */ Perl_ck_each, /* each */ Perl_ck_each, /* values */ Perl_ck_each, /* keys */ @@ -1755,6 +1758,7 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */ Perl_ck_null, /* once */ Perl_ck_null, /* custom */ Perl_ck_null, /* coreargs */ + Perl_ck_null, /* avhvswitch */ Perl_ck_null, /* runcv */ Perl_ck_fun, /* fc */ Perl_ck_null, /* padcv */ @@ -1920,8 +1924,8 @@ EXTCONST U32 PL_opargs[] = { 0x00023401, /* aslice */ 0x00023401, /* kvaslice */ 0x00003b40, /* aeach */ - 0x00003b08, /* akeys */ 0x00003b48, /* avalues */ + 0x00003b08, /* akeys */ 0x00004b40, /* each */ 0x00004b48, /* values */ 0x00004b08, /* keys */ @@ -2160,6 +2164,7 @@ EXTCONST U32 PL_opargs[] = { 0x00000300, /* once */ 0x00000000, /* custom */ 0x00000600, /* coreargs */ + 0x00000108, /* avhvswitch */ 0x00000004, /* runcv */ 0x00009b8e, /* fc */ 0x00000040, /* padcv */ @@ -2401,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, @@ -2557,8 +2563,8 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 96, /* aslice */ 99, /* kvaslice */ 0, /* aeach */ - 39, /* akeys */ 0, /* avalues */ + 39, /* akeys */ 0, /* each */ 0, /* values */ 39, /* keys */ @@ -2797,16 +2803,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = { 0, /* once */ -1, /* custom */ 181, /* coreargs */ + 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 */ }; @@ -2833,15 +2840,15 @@ EXTCONST U16 PL_op_private_bitdefs[] = { 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, ... [14 chars truncated] - 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, rea ... [363 chars truncated] + 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] 0x325c, 0x3178, 0x2634, 0x2570, 0x0003, /* backtick */ 0x3818, 0x0003, /* substcont */ 0x0f1c, 0x1f58, 0x0754, 0x3b8c, 0x22e8, 0x01e4, 0x0141, /* trans, transr */ @@ -2850,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, getpgr ... [46 chars truncated] - 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, getpgr ... [46 chars truncated] + 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 */ @@ -2868,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, ... [12 chars truncated] 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 */ @@ -3038,8 +3046,8 @@ EXTCONST U8 PL_op_private_valid[] = { /* ASLICE */ (OPpSLICEWARNING|OPpMAYBE_LVSUB|OPpLVAL_INTRO), /* KVASLICE */ (OPpMAYBE_LVSUB), /* AEACH */ (OPpARG1_MASK), - /* AKEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), /* AVALUES */ (OPpARG1_MASK), + /* AKEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), /* EACH */ (OPpARG1_MASK), /* VALUES */ (OPpARG1_MASK), /* KEYS */ (OPpARG1_MASK|OPpMAYBE_LVSUB), @@ -3278,6 +3286,7 @@ EXTCONST U8 PL_op_private_valid[] = { /* ONCE */ (OPpARG1_MASK), /* CUSTOM */ (0xff), /* COREARGS */ (OPpCOREARGS_DEREF1|OPpCOREARGS_DEREF2|OPpCOREARGS_SCALARMOD|OPpCOREARGS_PUSHMARK), + /* AVHVSWITCH */ (3|OPpMAYBE_LVSUB), /* RUNCV */ (OPpOFFBYONE), /* FC */ (OPpARG1_MASK), /* PADCV */ (0), diff --git a/opnames.h b/opnames.h index 065c1a8..99b19d0 100644 --- a/opnames.h +++ b/opnames.h @@ -156,8 +156,8 @@ typedef enum opcode { OP_ASLICE = 139, OP_KVASLICE = 140, OP_AEACH = 141, - OP_AKEYS = 142, - OP_AVALUES = 143, + OP_AVALUES = 142, + OP_AKEYS = 143, OP_EACH = 144, OP_VALUES = 145, OP_KEYS = 146, @@ -396,21 +396,22 @@ typedef enum opcode { OP_ONCE = 379, OP_CUSTOM = 380, OP_COREARGS = 381, - OP_RUNCV = 382, - OP_FC = 383, - OP_PADCV = 384, - OP_INTROCV = 385, - OP_CLONECV = 386, - OP_PADRANGE = 387, - OP_REFASSIGN = 388, - OP_LVREF = 389, - OP_LVREFSLICE = 390, - OP_LVAVREF = 391, - OP_ANONCONST = 392, + OP_AVHVSWITCH = 382, + OP_RUNCV = 383, + OP_FC = 384, + OP_PADCV = 385, + OP_INTROCV = 386, + OP_CLONECV = 387, + OP_PADRANGE = 388, + OP_REFASSIGN = 389, + OP_LVREF = 390, + OP_LVREFSLICE = 391, + OP_LVAVREF = 392, + OP_ANONCONST = 393, OP_max } opcode; -#define MAXO 393 +#define MAXO 394 #define OP_FREED MAXO /* the OP_IS_* macros are optimized to a simple range check because diff --git a/pod/perldiag.pod b/pod/perldiag.pod index d0b5f25..2210a60 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -4531,6 +4531,12 @@ was string. (P) The compiler is screwed up and attempted to use an op that isn't permitted at run time. +=item panic: unknown OA_*: %x + +(P) The internal routine that handles arguments to C<&CORE::foo()> +subroutine calls was unable to determine what type of arguments +were expected. + =item panic: utf16_to_utf8: odd bytelen (P) Something tried to call utf16_to_utf8 with an odd (as opposed diff --git a/pp.c b/pp.c index 9148286..17f31af 100644 --- a/pp.c +++ b/pp.c @@ -4845,7 +4845,10 @@ PP(pp_akeys) EXTEND(SP, n + 1); - if (PL_op->op_type == OP_AKEYS) { + if ( PL_op->op_type == OP_AKEYS + || ( PL_op->op_type == OP_AVHVSWITCH + && (PL_op->op_private & 3) + OP_AEACH == OP_AKEYS )) + { for (i = 0; i <= n; i++) { mPUSHi(i); } @@ -6238,6 +6241,18 @@ PP(unimplemented_op) DIE(aTHX_ "panic: unimplemented op %s (#%d) called", name, op_type); } +static void +S_maybe_unwind_defav(pTHX) +{ + if (CX_CUR()->cx_type & CXp_HASARGS) { + PERL_CONTEXT *cx = CX_CUR(); + + assert(CxHASARGS(cx)); + cx_popsub_args(cx); + cx->cx_type &= ~CXp_HASARGS; + } +} + /* For sorting out arguments passed to a &CORE:: subroutine */ PP(pp_coreargs) { @@ -6308,13 +6323,39 @@ PP(pp_coreargs) svp++; } RETURN; + case OA_AVREF: + if (!numargs) { + GV *gv; + if (CvUNIQUE(find_runcv_where(FIND_RUNCV_level_eq,1,NULL))) + gv = PL_argvgv; + else { + S_maybe_unwind_defav(aTHX); + gv = PL_defgv; + } + PUSHs((SV *)GvAVn(gv)); + break; + } + if (!svp || !*svp || !SvROK(*svp) + || SvTYPE(SvRV(*svp)) != SVt_PVAV) + DIE(aTHX_ + /* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/ + "Type of arg %d to &CORE::%s must be array reference", + whicharg, PL_op_desc[opnum] + ); + PUSHs(SvRV(*svp)); + break; case OA_HVREF: if (!svp || !*svp || !SvROK(*svp) - || SvTYPE(SvRV(*svp)) != SVt_PVHV) + || ( SvTYPE(SvRV(*svp)) != SVt_PVHV + && ( opnum == OP_DBMCLOSE || opnum == OP_DBMOPEN + || SvTYPE(SvRV(*svp)) != SVt_PVAV ))) DIE(aTHX_ /* diag_listed_as: Type of arg %d to &CORE::%s must be %s*/ - "Type of arg %d to &CORE::%s must be hash reference", - whicharg, OP_DESC(PL_op->op_next) + "Type of arg %d to &CORE::%s must be hash%s reference", + whicharg, PL_op_desc[opnum], + opnum == OP_DBMCLOSE || opnum == OP_DBMOPEN + ? "" + : " or array" ); PUSHs(SvRV(*svp)); break; @@ -6359,15 +6400,10 @@ PP(pp_coreargs) : "reference to one of [$@%*]" ); PUSHs(SvRV(*svp)); - if (opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv - && CX_CUR()->cx_type & CXp_HASARGS) { + if (opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv) { /* Undo @_ localisation, so that sub exit does not undo part of our undeffing. */ - PERL_CONTEXT *cx = CX_CUR(); - - assert(CxHASARGS(cx)); - cx_popsub_args(cx);; - cx->cx_type &= ~CXp_HASARGS; + S_maybe_unwind_defav(aTHX); } } break; @@ -6380,6 +6416,15 @@ PP(pp_coreargs) RETURN; } +PP(pp_avhvswitch) +{ + dSP; + return PL_ppaddr[ + (SvTYPE(TOPs) == SVt_PVAV ? OP_AEACH : OP_EACH) + + (PL_op->op_private & 3) + ](aTHX); +} + PP(pp_runcv) { dSP; diff --git a/pp_proto.h b/pp_proto.h index 17241d3..fd54df8 100644 --- a/pp_proto.h +++ b/pp_proto.h @@ -22,6 +22,7 @@ PERL_CALLCONV OP *Perl_pp_anonlist(pTHX); PERL_CALLCONV OP *Perl_pp_aslice(pTHX); PERL_CALLCONV OP *Perl_pp_atan2(pTHX); PERL_CALLCONV OP *Perl_pp_av2arylen(pTHX); +PERL_CALLCONV OP *Perl_pp_avhvswitch(pTHX); PERL_CALLCONV OP *Perl_pp_backtick(pTHX); PERL_CALLCONV OP *Perl_pp_bind(pTHX); PERL_CALLCONV OP *Perl_pp_binmode(pTHX); diff --git a/regen/op_private b/regen/op_private index c8b9652..e291295 100644 --- a/regen/op_private +++ b/regen/op_private @@ -198,7 +198,7 @@ use strict; # find which ops use 0,1,2,3 or 4 bits of op_private for arg count info - $args0{$_} = 1 for qw(entersub); # UNOPs that usurp bit 0 + $args0{$_} = 1 for qw(entersub avhvswitch); # UNOPs that usurp bit 0 $args1{$_} = 1 for ( qw(reverse), # ck_fun(), but most bits stolen @@ -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); @@ -758,6 +758,10 @@ addbits('multideref', 5 => qw(OPpMULTIDEREF_DELETE DELETE), # deref is actually delete ); + + +addbits('avhvswitch', '0..1' => { }); + 1; # ex: set ts=8 sts=4 sw=4 et: diff --git a/regen/opcodes b/regen/opcodes index 9ea0753..893deb0 100644 --- a/regen/opcodes +++ b/regen/opcodes @@ -231,8 +231,8 @@ aslice array slice ck_null m@ A L kvaslice index/value array slice ck_null m@ A L aeach each on array ck_each d% A -akeys keys on array ck_each t% A avalues values on array ck_each dt% A +akeys keys on array ck_each t% A # Hashes. @@ -556,6 +556,7 @@ custom unknown custom operator ck_null 0 # For CORE:: subs coreargs CORE:: subroutine ck_null $ +avhvswitch Array/hash switch ck_null t1 runcv __SUB__ ck_null s0 diff --git a/t/op/coreamp.t b/t/op/coreamp.t index 7a99155..e35f4f3 100644 --- a/t/op/coreamp.t +++ b/t/op/coreamp.t @@ -23,6 +23,9 @@ sub lis($$;$) { package hov { use overload '%{}' => sub { +{} } } +package aov { + use overload '@{}' => sub { [] } +} package sov { use overload '${}' => sub { \my $x } } @@ -205,6 +208,72 @@ sub test_proto { "&$o with coderef arg"; } } + elsif ($p =~ /^;?\\\@([\@;])?/) { # ;\@ \@@ \@;$$@ + $tests += 7; + + if ($1) { + eval { &{"CORE::$o"}() }; + like $@, qr/^Not enough arguments for $o at /, + "&$o with too few args"; + } + else { + eval " &CORE::$o(\\\@1,2) "; + like $@, qr/^Too many arguments for $o at /, + "&$o with too many args"; + } + eval " &CORE::$o(2) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be array reference at /, + "&$o with non-ref arg"; + eval " &CORE::$o(*STDOUT{IO}) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be array reference at /, + "&$o with ioref arg"; + my $class = ref *DATA{IO}; + eval " &CORE::$o(bless(*DATA{IO}, 'aov')) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be array reference at /, + "&$o with ioref arg with array overload (which does not count)"; + bless *DATA{IO}, $class; + eval " &CORE::$o(\\&scriggle) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be array reference at /, + "&$o with coderef arg"; + eval " &CORE::$o(\\\$_) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be array reference at /, + "&$o with scalarref arg"; + eval " &CORE::$o({}) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be array reference at /, + "&$o with hashref arg"; + } + elsif ($p eq '\[%@]') { + $tests += 7; + + eval " &CORE::$o(\\%1,2) "; + like $@, qr/^Too many arguments for ${\op_desc($o)} at /, + "&$o with too many args"; + eval { &{"CORE::$o"}() }; + like $@, qr/^Not enough arguments for $o at /, + "&$o with too few args"; + eval " &CORE::$o(2) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x: + )reference at /, + "&$o with non-ref arg"; + eval " &CORE::$o(*STDOUT{IO}) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x: + )reference at /, + "&$o with ioref arg"; + my $class = ref *DATA{IO}; + eval " &CORE::$o(bless(*DATA{IO}, 'hov')) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x: + )reference at /, + "&$o with ioref arg with hash overload (which does not count)"; + bless *DATA{IO}, $class; + eval " &CORE::$o(\\&scriggle) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x: + )reference at /, + "&$o with coderef arg"; + eval " &CORE::$o(\\\$_) "; + like $@, qr/^Type of arg 1 to &CORE::$o must be hash or array (?x: + )reference at /, + "&$o with scalarref arg"; + } elsif ($p eq ';\[$*]') { $tests += 4; @@ -468,6 +537,13 @@ is &myformline(' @<<< @>>>', 1, 2), 1, '&myformline retval'; is $^A, ' 1 2', 'effect of &myformline'; lis [&myformline('@')], [1], '&myformline in list context'; +test_proto 'each'; +$tests += 4; +is &myeach({ "a","b" }), "a", '&myeach(\%hash) in scalar cx'; +lis [&myeach({qw<a b>})], [qw<a b>], '&myeach(\%hash) in list cx'; +is &myeach([ "a","b" ]), 0, '&myeach(\@array) in scalar cx'; +lis [&myeach([qw<a b>])], [qw<0 a>], '&myeach(\@array) in list cx'; + test_proto 'exp'; test_proto 'fc'; @@ -549,6 +625,20 @@ $tests += 2; is &myjoin('a','b','c'), 'bac', '&join'; lis [&myjoin('a','b','c')], ['bac'], '&join in list context'; +test_proto 'keys'; +$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') { $tests ++; @@ -617,6 +707,21 @@ lis [&mypack("H*", $Perl_as_a_hex_string)], ['Perl'], '&pack in list context'; test_proto 'pipe'; +test_proto 'pop'; +$tests += 6; +@ARGV = qw<a b c>; +is &mypop(), 'c', 'retval of &pop with no args (@ARGV)'; +is "@ARGV", "a b", 'effect of &pop on @ARGV'; +sub { + is &mypop(), 'k', 'retval of &pop with no args (@_)'; + is "@_", "q j", 'effect of &pop on @_'; +}->(qw(q j k)); +{ + my @a = 1..4; + is &mypop(\@a), 4, 'retval of &pop'; + lis [@a], [1..3], 'effect of &pop'; +} + test_proto 'pos'; $tests += 4; $_ = "hello"; @@ -636,6 +741,14 @@ test_proto 'prototype'; $tests++; is &myprototype(\&myprototype), prototype("CORE::prototype"), '&prototype'; +test_proto 'push'; +$tests += 2; +{ + my @a = qw<a b c>; + is &mypush(\@a, "d", "e"), 5, 'retval of &push'; + is "@a", "a b c d e", 'effect of &push'; +} + test_proto 'quotemeta', '$', '\$'; test_proto 'rand'; @@ -801,12 +914,44 @@ test_proto "set$_" for qw ' priority protoent pwent servent sockopt '; +test_proto 'shift'; +$tests += 6; +@ARGV = qw<a b c>; +is &myshift(), 'a', 'retval of &shift with no args (@ARGV)'; +is "@ARGV", "b c", 'effect of &shift on @ARGV'; +sub { + is &myshift(), 'q', 'retval of &shift with no args (@_)'; + is "@_", "j k", 'effect of &shift on @_'; +}->(qw(q j k)); +{ + my @a = 1..4; + is &myshift(\@a), 1, 'retval of &shift'; + lis [@a], [2..4], 'effect of &shift'; +} + test_proto "shm$_" for qw "ctl get read write"; test_proto 'shutdown'; test_proto 'sin'; test_proto 'sleep'; test_proto "socket$_" for "", "pair"; +test_proto 'splice'; +$tests += 8; +{ + my @a = qw<a b c>; + is &mysplice(\@a, 1), 'c', 'retval of 2-arg &splice in scalar context'; + lis \@a, ['a'], 'effect of 2-arg &splice in scalar context'; + @a = qw<a b c>; + lis [&mysplice(\@a, 1)], ['b','c'], 'retval of 2-arg &splice in list cx'; + lis \@a, ['a'], 'effect of 2-arg &splice in list context'; + @a = qw<a b c d>; + lis [&mysplice(\@a,1,2)],['b','c'], 'retval of 3-arg &splice in list cx'; + lis \@a, ['a','d'], 'effect of 3-arg &splice in list context'; + @a = qw<a b c d>; + lis [&mysplice(\@a,1,1,'e')],['b'], 'retval of 4-arg &splice in list cx'; + lis \@a, [qw<a e c d>], 'effect of 4-arg &splice in list context'; +} + test_proto 'sprintf'; $tests += 2; is &mysprintf("%x", 65), '41', '&sprintf'; @@ -936,6 +1081,14 @@ is &myunpack("H*"), $abcd_as_a_hex_string, '&unpack with one arg'; is &myunpack("H*", "bcde"), $bcde_as_a_hex_string, '&unpack with two arg'; +test_proto 'unshift'; +$tests += 2; +{ + my @a = qw<a b c>; + is &myunshift(\@a, "d", "e"), 5, 'retval of &unshift'; + is "@a", "d e a b c", 'effect of &unshift'; +} + test_proto 'untie'; # behaviour already tested along with tie(d) test_proto 'utime'; @@ -943,6 +1096,13 @@ $tests += 2; is &myutime(undef,undef), 0, '&utime'; lis [&myutime(undef,undef)], [0], '&utime in list context'; +test_proto 'values'; +$tests += 4; +is &myvalues({ 1..4 }), 2, '&myvalues(\%hash) in scalar cx'; +lis [sort &myvalues({1..4})], [2,4], '&myvalues(\%hash) in list cx'; +is &myvalues([ 1..4 ]), 4, '&myvalues(\@array) in scalar cx'; +lis [&myvalues([ 1..4 ])], [1..4], '&myvalues(\@array) in list cx'; + test_proto 'vec'; $tests += 3; is &myvec("foo", 0, 4), 6, '&vec'; -- Perl5 Master Repository
