summaryrefslogtreecommitdiff
path: root/pp.h
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-06-26 21:12:18 -0500
committerJesse Luehrs <doy@tozt.net>2012-06-28 03:06:08 -0500
commit67288365cab33e76a48b697c001c11d4dc5b1912 (patch)
tree8d612e9bb96382ad1b99581ae81e4f2a7356828b /pp.h
parent591097e07a9ddfd1783a99ea394ab7e4113242b3 (diff)
downloadperl-67288365cab33e76a48b697c001c11d4dc5b1912.tar.gz
propagate context into overloads [perl #47119]
amagic_call now does its best to propagate the operator's context into the overload callback. It's not always possible - for instance, dereferencing and stringify/boolify/numify always have to return a value, even if it's not used, due to the way the overload callback works in those cases - but the majority of cases should now work. In particular, overloading <> to handle list context properly is now possible. For backcompat reasons (amagic_call and friends are technically public api functions), list context will not be propagated unless specifically requested via the AMGf_want_list flag. If this is passed, and the operator is called in list context, amagic_call returns an AV* holding all of the returned values instead of an SV*. Void context always results in amagic_call returning &PL_sv_undef.
Diffstat (limited to 'pp.h')
-rw-r--r--pp.h35
1 files changed, 28 insertions, 7 deletions
diff --git a/pp.h b/pp.h
index 93aeb914f0..4661f4243f 100644
--- a/pp.h
+++ b/pp.h
@@ -397,6 +397,7 @@ Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
#define AMGf_unary 8
#define AMGf_numeric 0x10 /* for Perl_try_amagic_bin */
#define AMGf_set 0x20 /* for Perl_try_amagic_bin */
+#define AMGf_want_list 0x40
/* do SvGETMAGIC on the stack args before checking for overload */
@@ -418,21 +419,41 @@ Does not use C<TARG>. See also C<XPUSHu>, C<mPUSHu> and C<PUSHu>.
/* No longer used in core. Use AMG_CALLunary instead */
#define AMG_CALLun(sv,meth) AMG_CALLunary(sv, CAT2(meth,_amg))
-#define tryAMAGICunTARGET(meth, shift, jump) \
+#define tryAMAGICunTARGET(meth, shift, jump) \
+ tryAMAGICunTARGET_flags(meth, shift, jump, 0)
+#define tryAMAGICunTARGETlist(meth, shift, jump) \
+ tryAMAGICunTARGET_flags(meth, shift, jump, AMGf_want_list)
+#define tryAMAGICunTARGET_flags(meth, shift, jump, flags) \
STMT_START { \
- dATARGET; \
dSP; \
SV *tmpsv; \
SV *arg= sp[shift]; \
+ int gimme = GIMME_V; \
if (SvAMAGIC(arg) && \
(tmpsv = amagic_call(arg, &PL_sv_undef, meth, \
- AMGf_noright | AMGf_unary))) { \
+ flags | AMGf_noright | AMGf_unary))) { \
SPAGAIN; \
sp += shift; \
- sv_setsv(TARG, tmpsv); \
- if (opASSIGN) \
- sp--; \
- SETTARG; \
+ if (gimme == G_VOID) { \
+ (void)POPs; /* XXX ??? */ \
+ } \
+ else if ((flags & AMGf_want_list) && gimme == G_ARRAY) { \
+ int i; \
+ I32 len; \
+ assert(SvTYPE(tmpsv) == SVt_PVAV); \
+ len = av_len((AV *)tmpsv) + 1; \
+ (void)POPs; /* get rid of the arg */ \
+ EXTEND(sp, len); \
+ for (i = 0; i < len; ++i) \
+ PUSHs(av_shift((AV *)tmpsv)); \
+ } \
+ else { /* AMGf_want_scalar */ \
+ dATARGET; /* just use the arg's location */ \
+ sv_setsv(TARG, tmpsv); \
+ if (opASSIGN) \
+ sp--; \
+ SETTARG; \
+ } \
PUTBACK; \
if (jump) { \
OP *jump_o = NORMAL->op_next; \