diff options
| -rw-r--r-- | av.c | 4 | ||||
| -rw-r--r-- | cop.h | 3 | ||||
| -rw-r--r-- | embed.fnc | 2 | ||||
| -rw-r--r-- | mg.c | 30 | ||||
| -rw-r--r-- | proto.h | 2 |
5 files changed, 20 insertions, 21 deletions
@@ -632,8 +632,8 @@ Perl_av_unshift(pTHX_ register AV *av, register I32 num) Perl_croak(aTHX_ "%s", PL_no_modify); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD, - -num, NULL, NULL); + magic_methcall(MUTABLE_SV(av), mg, "UNSHIFT", G_DISCARD | G_UNDEF_FILL, + num, NULL, NULL); return; } @@ -783,6 +783,9 @@ L<perlcall>. #define G_METHOD 128 /* Calling method. */ #define G_FAKINGEVAL 256 /* Faking an eval context for call_sv or fold_constants. */ +#define G_UNDEF_FILL 512 /* Fill the stack with &PL_sv_undef + A special case for UNSHIFT in + Perl_magic_methcall(). */ /* flag bits for PL_in_eval */ #define EVAL_NULL 0 /* not in an eval */ @@ -684,7 +684,7 @@ p |U32 |magic_sizepack |NN SV* sv|NN MAGIC* mg p |int |magic_wipepack |NN SV* sv|NN MAGIC* mg pd |SV* |magic_methcall |NN SV *sv|NN const MAGIC *mg \ |NN const char *meth|U32 flags \ - |int n|NULLOK SV* arg1|NULLOK SV* arg2 + |U32 argc|NULLOK SV* arg1|NULLOK SV* arg2 Ap |void |markstack_grow #if defined(USE_LOCALE_COLLATE) p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg @@ -1649,10 +1649,12 @@ Invoke a magic method (like FETCH). * sv and mg are the tied thinggy and the tie magic; * meth is the name of the method to call; -* n, arg1, arg2 are the number of args (in addition to $self) to pass to - the method, and the args themselves (negative n is special-cased); +* argc, arg1, arg2 are the number of args (in addition to $self) to pass to + the method, and the args themselves * flags: G_DISCARD: invoke method with G_DISCARD flag and don't return a value + G_UNDEF_FILL: fill the stack with argc pointers to PL_sv_undef; + ignore arg1 and arg2. Returns the SV (if any) returned by the method, or NULL on failure. @@ -1662,7 +1664,7 @@ Returns the SV (if any) returned by the method, or NULL on failure. SV* Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, - int n, SV *arg1, SV *arg2) + U32 argc, SV *arg1, SV *arg2) { dVAR; dSP; @@ -1674,22 +1676,16 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, PUSHSTACKi(PERLSI_MAGIC); PUSHMARK(SP); - if (n < 0) { - /* special case for UNSHIFT */ - EXTEND(SP,-n+1); - PUSHs(SvTIED_obj(sv, mg)); - while (n++ < 0) { + EXTEND(SP, argc+1); + PUSHs(SvTIED_obj(sv, mg)); + if (flags & G_UNDEF_FILL) { + while (argc--) { PUSHs(&PL_sv_undef); } - } - else { - EXTEND(SP,n+1); - PUSHs(SvTIED_obj(sv, mg)); - if (n > 0) { - PUSHs(arg1); - if (n > 1) PUSHs(arg2); - assert(n <= 2); - } + } else if (argc > 0) { + PUSHs(arg1); + if (argc > 1) PUSHs(arg2); + assert(argc <= 2); } PUTBACK; if (flags & G_DISCARD) { @@ -1904,7 +1904,7 @@ PERL_CALLCONV int Perl_magic_wipepack(pTHX_ SV* sv, MAGIC* mg) #define PERL_ARGS_ASSERT_MAGIC_WIPEPACK \ assert(sv); assert(mg) -PERL_CALLCONV SV* Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, int n, SV* arg1, SV* arg2) +PERL_CALLCONV SV* Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 n, SV* arg1, SV* arg2) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2) __attribute__nonnull__(pTHX_3); |