summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--av.c18
-rw-r--r--embed.fnc4
-rw-r--r--embed.h2
-rw-r--r--mg.c29
-rw-r--r--proto.h2
5 files changed, 29 insertions, 26 deletions
diff --git a/av.c b/av.c
index acedd00dfb..b93a6d5e94 100644
--- a/av.c
+++ b/av.c
@@ -76,7 +76,8 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
if (mg) {
SV *arg1 = sv_newmortal();
sv_setiv(arg1, (IV)(key + 1));
- magic_methcall(MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1, arg1, NULL);
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "EXTEND", G_DISCARD, 1,
+ arg1);
return;
}
if (key > AvMAX(av)) {
@@ -544,7 +545,8 @@ Perl_av_push(pTHX_ register AV *av, SV *val)
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- magic_methcall(MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1, val, NULL);
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "PUSH", G_DISCARD, 1,
+ val);
return;
}
av_store(av,AvFILLp(av)+1,val);
@@ -572,7 +574,7 @@ Perl_av_pop(pTHX_ register AV *av)
if (SvREADONLY(av))
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- retval = magic_methcall(MUTABLE_SV(av), mg, "POP", 0, 0, NULL, NULL);
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "POP", 0, 0);
if (retval)
retval = newSVsv(retval);
return retval;
@@ -632,8 +634,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 | G_UNDEF_FILL,
- num, NULL, NULL);
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "UNSHIFT",
+ G_DISCARD | G_UNDEF_FILL, num);
return;
}
@@ -693,7 +695,7 @@ Perl_av_shift(pTHX_ register AV *av)
if (SvREADONLY(av))
Perl_croak(aTHX_ "%s", PL_no_modify);
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
- retval = magic_methcall(MUTABLE_SV(av), mg, "SHIFT", 0, 0, NULL, NULL);
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "SHIFT", 0, 0);
if (retval)
retval = newSVsv(retval);
return retval;
@@ -757,8 +759,8 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) {
SV *arg1 = sv_newmortal();
sv_setiv(arg1, (IV)(fill + 1));
- magic_methcall(MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
- 1, arg1, NULL);
+ Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, "STORESIZE", G_DISCARD,
+ 1, arg1);
return;
}
if (fill <= AvMAX(av)) {
diff --git a/embed.fnc b/embed.fnc
index b48f95ea57..be7debe1ac 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -682,9 +682,9 @@ p |int |magic_setutf8 |NN SV* sv|NN MAGIC* mg
p |int |magic_set_all_env|NN SV* sv|NN MAGIC* mg
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 \
+pod |SV* |magic_methcall |NN SV *sv|NN const MAGIC *mg \
|NN const char *meth|U32 flags \
- |U32 argc|NULLOK SV* arg1|NULLOK SV* arg2
+ |U32 argc|...
Ap |void |markstack_grow
#if defined(USE_LOCALE_COLLATE)
p |int |magic_setcollxfrm|NN SV* sv|NN MAGIC* mg
diff --git a/embed.h b/embed.h
index 7df5930bdc..a3f7408b1c 100644
--- a/embed.h
+++ b/embed.h
@@ -514,7 +514,6 @@
#define magic_set_all_env Perl_magic_set_all_env
#define magic_sizepack Perl_magic_sizepack
#define magic_wipepack Perl_magic_wipepack
-#define magic_methcall Perl_magic_methcall
#endif
#define markstack_grow Perl_markstack_grow
#if defined(USE_LOCALE_COLLATE)
@@ -2929,7 +2928,6 @@
#define magic_set_all_env(a,b) Perl_magic_set_all_env(aTHX_ a,b)
#define magic_sizepack(a,b) Perl_magic_sizepack(aTHX_ a,b)
#define magic_wipepack(a,b) Perl_magic_wipepack(aTHX_ a,b)
-#define magic_methcall(a,b,c,d,e,f,g) Perl_magic_methcall(aTHX_ a,b,c,d,e,f,g)
#endif
#define markstack_grow() Perl_markstack_grow(aTHX)
#if defined(USE_LOCALE_COLLATE)
diff --git a/mg.c b/mg.c
index 66d777f1c9..c89be40f5f 100644
--- a/mg.c
+++ b/mg.c
@@ -1664,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,
- U32 argc, SV *arg1, SV *arg2)
+ U32 argc, ...)
{
dVAR;
dSP;
@@ -1683,9 +1683,15 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
PUSHs(&PL_sv_undef);
}
} else if (argc > 0) {
- PUSHs(arg1);
- if (argc > 1) PUSHs(arg2);
- assert(argc <= 2);
+ va_list args;
+ va_start(args, argc);
+
+ do {
+ SV *const sv = va_arg(args, SV *);
+ PUSHs(sv);
+ } while (--argc);
+
+ va_end(args);
}
PUTBACK;
if (flags & G_DISCARD) {
@@ -1724,10 +1730,9 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags,
sv_2mortal(arg1);
}
if (!arg1) {
- arg1 = val;
- n--;
+ return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val);
}
- return magic_methcall(sv, mg, meth, flags, n, arg1, val);
+ return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val);
}
STATIC int
@@ -1821,7 +1826,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
PERL_ARGS_ASSERT_MAGIC_WIPEPACK;
- magic_methcall(sv, mg, "CLEAR", G_DISCARD, 0, NULL, NULL);
+ Perl_magic_methcall(aTHX_ sv, mg, "CLEAR", G_DISCARD, 0);
return 0;
}
@@ -1833,10 +1838,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
PERL_ARGS_ASSERT_MAGIC_NEXTPACK;
- ret = magic_methcall(sv, mg,
- (SvOK(key) ? "NEXTKEY" : "FIRSTKEY"),
- 0,
- (SvOK(key) ? 1 : 0), key, NULL);
+ ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, "NEXTKEY", 0, 1, key)
+ : Perl_magic_methcall(aTHX_ sv, mg, "FIRSTKEY", 0, 0);
if (ret)
sv_setsv(key,ret);
return 0;
@@ -1873,7 +1876,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
}
/* there is a SCALAR method that we can call */
- retval = magic_methcall(MUTABLE_SV(hv), mg, "SCALAR", 0, 0, NULL, NULL);
+ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, "SCALAR", 0, 0);
if (!retval)
retval = &PL_sv_undef;
return retval;
diff --git a/proto.h b/proto.h
index 207beedb44..9f897830f8 100644
--- a/proto.h
+++ b/proto.h
@@ -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, U32 n, SV* arg1, SV* arg2)
+PERL_CALLCONV SV* Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, U32 flags, U32 argc, ...)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2)
__attribute__nonnull__(pTHX_3);
View Lorry Controller Status