@@ -7635,6 +7635,23 @@ PP(pp_anonconst)
76357635}
76367636
76377637
7638+ /* Helper function for use during signature argument handling from @_.
7639+ * Replaces elements in an AV with a new SV cloned from the original value
7640+ * at each position from startix onwards until endix.
7641+ */
7642+ #define av_refresh_elements_range (av , startix , endix ) S_av_refresh_elements_range(aTHX_ av, startix, endix)
7643+ STATIC void
7644+ S_av_refresh_elements_range (pTHX_ AV * av , IV startix , IV endix )
7645+ {
7646+ for (IV ix = startix ; ix < endix ; ix ++ ) {
7647+ SV * * svp = av_fetch (av , ix , FALSE);
7648+ SV * newsv = newSVsv_flags (svp ? * svp : & PL_sv_undef ,
7649+ (SV_DO_COW_SVSETSV |SV_NOSTEAL ));
7650+ if (!av_store (av , ix , newsv ))
7651+ SvREFCNT_dec_NN (newsv );
7652+ }
7653+ }
7654+
76387655/* process one subroutine argument - typically when the sub has a signature:
76397656 * introduce PL_curpad[op_targ] and assign to it the value
76407657 * for $: (OPf_STACKED ? *sp : $_[N])
@@ -7713,13 +7730,7 @@ PP_wrapped(pp_argelem,
77137730 * to avoid the equivalent of @a = ($a[0]) prematurely freeing
77147731 * elements. See similar code in pp_aassign.
77157732 */
7716- for (i = 0 ; i < argc ; i ++ ) {
7717- SV * * svp = av_fetch (defav , ix + i , FALSE);
7718- SV * newsv = newSVsv_flags (svp ? * svp : & PL_sv_undef ,
7719- (SV_DO_COW_SVSETSV |SV_NOSTEAL ));
7720- if (!av_store (defav , ix + i , newsv ))
7721- SvREFCNT_dec_NN (newsv );
7722- }
7733+ av_refresh_elements_range (defav , ix , ix + argc );
77237734 av_clear ((AV * )targ );
77247735 }
77257736
@@ -7745,13 +7756,7 @@ PP_wrapped(pp_argelem,
77457756
77467757 if (SvRMAGICAL (targ ) || HvUSEDKEYS ((HV * )targ )) {
77477758 /* see "target should usually be empty" comment above */
7748- for (i = 0 ; i < argc ; i ++ ) {
7749- SV * * svp = av_fetch (defav , ix + i , FALSE);
7750- SV * newsv = newSVsv_flags (svp ? * svp : & PL_sv_undef ,
7751- (SV_DO_COW_SVSETSV |SV_NOSTEAL ));
7752- if (!av_store (defav , ix + i , newsv ))
7753- SvREFCNT_dec_NN (newsv );
7754- }
7759+ av_refresh_elements_range (defav , ix , ix + argc );
77557760 hv_clear ((HV * )targ );
77567761 }
77577762
@@ -7842,20 +7847,10 @@ S_find_runcv_name(void)
78427847 * signatured subs.
78437848 */
78447849
7845- PP (pp_argcheck )
7850+ static void
7851+ S_check_argc (pTHX_ UV argc , UV params , UV opt_params , char slurpy )
78467852{
7847- OP * const o = PL_op ;
7848- struct op_argcheck_aux * aux = (struct op_argcheck_aux * )cUNOP_AUXo -> op_aux ;
7849- UV params = aux -> params ;
7850- UV opt_params = aux -> opt_params ;
7851- char slurpy = aux -> slurpy ;
7852- AV * defav = GvAV (PL_defgv ); /* @_ */
7853- UV argc ;
7854- bool too_few ;
7855-
7856- assert (!SvMAGICAL (defav ));
7857- argc = (UV )(AvFILLp (defav ) + 1 );
7858- too_few = (argc < (params - opt_params ));
7853+ bool too_few = (argc < (params - opt_params ));
78597854
78607855 if (UNLIKELY (too_few || (!slurpy && argc > params )))
78617856
@@ -7874,6 +7869,18 @@ PP(pp_argcheck)
78747869 /* diag_listed_as: Odd name/value argument for subroutine '%s' */
78757870 Perl_croak_caller ("Odd name/value argument for subroutine '%" SVf "'" ,
78767871 S_find_runcv_name ());
7872+ }
7873+
7874+ PP (pp_argcheck )
7875+ {
7876+ OP * const o = PL_op ;
7877+ struct op_argcheck_aux * aux = (struct op_argcheck_aux * )cUNOP_AUXo -> op_aux ;
7878+ AV * defav = GvAV (PL_defgv ); /* @_ */
7879+
7880+ assert (!SvMAGICAL (defav ));
7881+ UV argc = (UV )(AvFILLp (defav ) + 1 );
7882+
7883+ S_check_argc (aTHX_ argc , aux -> params , aux -> opt_params , aux -> slurpy );
78777884
78787885 return NORMAL ;
78797886}
0 commit comments