diff --git a/dump.c b/dump.c index 323fc46afe8a..ce8bb6c5ee15 100644 --- a/dump.c +++ b/dump.c @@ -1566,16 +1566,22 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_SIGNATURE: { struct op_signature_aux *aux = (struct op_signature_aux *)cUNOP_AUXo->op_aux; - S_opdump_indent(aTHX_ o, level, bar, file, "ARGS = %" UVuf " .. %" UVuf "\n", - aux->params, aux->opt_params); - if(aux->slurpy) - S_opdump_indent(aTHX_ o, level, bar, file, "SLURPY = '%c'\n", aux->slurpy); - UV nparams = aux->params; + if(aux->opt_params) + S_opdump_indent(aTHX_ o, level, bar, file, "PARAMS = %" UVuf " .. %" UVuf "\n", + nparams - aux->opt_params, nparams); + else + S_opdump_indent(aTHX_ o, level, bar, file, "PARAMS = %" UVuf "\n", + nparams); + for(Size_t i = 0; i < nparams; i++) S_opdump_indent(aTHX_ o, level, bar, file, " PARAM [%zd] PADIX = %" UVuf "\n", i, aux->param_padix[i]); + if(aux->slurpy) + S_opdump_indent(aTHX_ o, level, bar, file, "SLURPY = '%c' PADIX = %" UVuf "\n", + aux->slurpy, aux->slurpy_padix); + break; } diff --git a/op.h b/op.h index 0ff8c1cdfbe5..cfe20aa1959d 100644 --- a/op.h +++ b/op.h @@ -1184,6 +1184,7 @@ struct op_signature_aux { UV opt_params; char slurpy; PADOFFSET *param_padix; /* points at storage allocated along with the struct itself, immediately following */ + PADOFFSET slurpy_padix; }; #define MI_INIT_WORKAROUND_PACK "Module::Install::DSL" diff --git a/peep.c b/peep.c index 06496ab806ee..621f3e28cd02 100644 --- a/peep.c +++ b/peep.c @@ -1092,6 +1092,7 @@ S_optimize_signature_ops(pTHX_ OP *o) /* Now we should expect to see 'params' count of COP/ARGELEM pairs. Check * we have each, and **TODO** for now, none of them have an ARGDEFELEM */ + OP *final_argelem = NULL; for(int parami = 0; parami < nparams; parami++) { o = OpSIBLING(o); assert(o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE); @@ -1103,9 +1104,31 @@ S_optimize_signature_ops(pTHX_ OP *o) /* FOR NOW we don't support args with defaulting expressions */ if(o->op_flags & OPf_STACKED) return; + + final_argelem = o; + } + + if(argcheck_aux->slurpy) { + o = OpSIBLING(o); + assert(o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE); + + o = OpSIBLING(o); + + assert(o->op_type == OP_ARGELEM); + U8 priv = o->op_private & OPpARGELEM_MASK; + assert(priv == OPpARGELEM_AV || priv == OPpARGELEM_HV); + + final_argelem = o; + } + else { + /* TODO: Maybe look down the chain to see that we *don't* have an OP_ARGELEM ? */ } - /* TODO: If argcheck_aux->slurpy then we'll expect one more slurpy here */ + OP *next_after_args = (final_argelem) ? + final_argelem->op_next : argcheck->op_next; + OP *cop_after_args = (final_argelem && OpSIBLING(final_argelem)) ? + OpSIBLING(final_argelem) : OpSIBLING(argcheck); + assert(cop_after_args->op_type == OP_NEXTSTATE || cop_after_args->op_type == OP_DBSTATE); /* If we made it this far then we must be good */ @@ -1116,25 +1139,25 @@ S_optimize_signature_ops(pTHX_ OP *o) signature_aux->params = nparams; signature_aux->opt_params = argcheck_aux->opt_params; signature_aux->slurpy = argcheck_aux->slurpy; + signature_aux->slurpy_padix = 0; o = argcheck; - OP *final_argelem = NULL; for(int parami = 0; parami < argcheck_aux->params; parami++) { o = OpSIBLING(o); o = OpSIBLING(o); signature_aux->param_padix[parami] = o->op_targ; + } - final_argelem = o; + if(argcheck_aux->slurpy) { + o = OpSIBLING(o); + o = OpSIBLING(o); + + signature_aux->slurpy_padix = o->op_targ; } OP *signature = newUNOP_AUX(OP_SIGNATURE, 0, NULL, (UNOP_AUX_item *)signature_aux); - OP *next_after_args = (final_argelem) ? - final_argelem->op_next : argcheck->op_next; - OP *cop_after_args = (final_argelem && OpSIBLING(final_argelem)) ? - OpSIBLING(final_argelem) : OpSIBLING(argcheck); - /* TODO: Now throw away the *ENTIRE* previous argcheck/argelem... sequence * and replace it with this single OP_SIGNATURE */ diff --git a/pp.c b/pp.c index 2f74e3ba1561..24f2a06c2a34 100644 --- a/pp.c +++ b/pp.c @@ -7804,15 +7804,17 @@ PP(pp_argcheck) PP(pp_signature) { struct op_signature_aux *aux = (struct op_signature_aux *)cUNOP_AUX->op_aux; - UV nparams = aux->params; + UV nparams = aux->params; + char slurpy = aux->slurpy; AV *defav = GvAV(PL_defgv); /* @_ */ assert(!SvMAGICAL(defav)); UV argc = (UV)(AvFILLp(defav) + 1); - S_check_argc(aTHX_ argc, nparams, aux->opt_params, aux->slurpy); + S_check_argc(aTHX_ argc, nparams, aux->opt_params, slurpy); - for(UV parami = 0; parami < nparams; parami++) { + UV parami; + for(parami = 0; parami < nparams; parami++, argc--) { SV **padentry = &PAD_SVl(aux->param_padix[parami]); save_clearsv(padentry); @@ -7826,6 +7828,56 @@ PP(pp_signature) SvSetMagicSV(*padentry, val); } + if(!slurpy) + return PL_op->op_next; + + /* Now we know we have a slurpy */ + assert(aux->slurpy_padix); + SV **padentry = &PAD_SVl(aux->slurpy_padix); + save_clearsv(padentry); + + if(slurpy == '@') { + AV *av = (AV *)*padentry; + assert(SvTYPE(av) == SVt_PVAV); + + av_extend(av, argc); + + IV avidx = 0; + for(; argc; parami++, argc--) { + SV **valp = av_fetch(defav, parami, FALSE); + SV *val = valp ? *valp : &PL_sv_undef; + + assert(TAINTING_get || !TAINT_get); + if (UNLIKELY(TAINT_get) && !SvTAINTED(val)) + TAINT_NOT; + + av_store(av, avidx++, newSVsv(val)); + } + } + else if(slurpy == '%') { + HV *hv = (HV *)*padentry; + assert(SvTYPE(hv) == SVt_PVHV); + + assert((argc % 2) == 0); + + while(argc) { + SV **svp; + + svp = av_fetch(defav, parami, FALSE); parami++; + SV *key = svp ? *svp : &PL_sv_undef; + svp = av_fetch(defav, parami, FALSE); parami++; + SV *val = svp ? *svp : &PL_sv_undef; + argc -= 2; + + if (UNLIKELY(SvGMAGICAL(key))) + key = sv_mortalcopy(key); + + hv_store_ent(hv, key, newSVsv(val), 0); + if (UNLIKELY(TAINT_get) && !SvTAINTED(val)) + TAINT_NOT; + } + } + return PL_op->op_next; } diff --git a/t/op/signatures_faster.t b/t/op/signatures_faster.t index 510f7eb6d01b..d9550be732e2 100644 --- a/t/op/signatures_faster.t +++ b/t/op/signatures_faster.t @@ -44,4 +44,20 @@ fails_ok( sub { p2("a1") }, qr/^Too few arguments for subroutine 'main::p2' \(go fails_ok( sub { p2("a1","a2","a3") }, qr/^Too many arguments for subroutine 'main::p2' \(got 3; expected 2\) at /, 'p2 on three arguments' ); +# with slurpy array +sub p1sa ( $x, @rest ) { + return "P1SA-$x+" . join( '+', @rest ); +} +is( p1sa("a1", qw( a b c )), "P1SA-a1+a+b+c", 'p1sa OK' ); +fails_ok( sub { p1sa() }, qr/^Too few arguments for subroutine 'main::p1sa' \(got 0; expected at least 1\) at /, + 'p1sa on zero arguments' ); + +# with slurpy hash +sub p1sh ( $x, %rest ) { + return "P1SH-$x+" . join( '+', map { "$_=$rest{$_}" } sort keys %rest ); +} +is( p1sh("a1", a => "A", b => "B"), "P1SH-a1+a=A+b=B", 'p1ha OK' ); +fails_ok( sub { p1sh() }, qr/^Too few arguments for subroutine 'main::p1sh' \(got 0; expected at least 1\) at /, + 'p1sh on zero arguments' ); + done_testing; diff --git a/t/perf/opcount.t b/t/perf/opcount.t index f43b3aaa8154..81eb355ca8bd 100644 --- a/t/perf/opcount.t +++ b/t/perf/opcount.t @@ -1028,6 +1028,22 @@ test_opcount(0, "Empty anonhash ref and direct lexical assignment", argcheck => 0, argelem => 0, }); + + test_opcount(0, "One-arg plus slurpy array subroutine uses OP_SIGNATURE", + sub ($x, @rest) { return; }, + { + signature => 1, + argcheck => 0, + argelem => 0, + }); + + test_opcount(0, "One-arg plus slurpy hash subroutine uses OP_SIGNATURE", + sub ($x, %rest) { return; }, + { + signature => 1, + argcheck => 0, + argelem => 0, + }); } done_testing();