summaryrefslogtreecommitdiff
path: root/gv.c
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2010-05-21 14:18:21 +0100
committerDavid Mitchell <davem@iabyn.com>2010-05-21 14:18:21 +0100
commit6f1401dc2acd2a2b85df22b0a74e5f7e6e0a33aa (patch)
tree390fdb0620b4c8885249eab601f135442fe97ef6 /gv.c
parentc4648999f2aa0b971b46a580c1258b719394072a (diff)
downloadperl-6f1401dc2acd2a2b85df22b0a74e5f7e6e0a33aa.tar.gz
make overload respect get magic
In most places, ops checked their args for overload *before* doing mg_get(). This meant that, among other issues, tied vars that returned overloaded objects wouldn't trigger calling the overloaded method. (Actually, for tied and arrays and hashes, it still often would since mg_get gets called beforehand in rvalue context). This patch does the following: Makes sure get magic is called first. Moves most of the overload code formerly included by macros at the start of each pp function into the separate helper functions Perl_try_amagic_bin, Perl_try_amagic_un, S_try_amagic_ftest, with 3 new wrapper macros: tryAMAGICbin_MG, tryAMAGICun_MG, tryAMAGICftest_MG. This made the code 3800 bytes smaller. Makes sure that FETCH is not called multiple times. Much of this bit was helped by some earlier work from Father Chrysostomos. Added new functions and macros sv_inc_nomg(), sv_dec_nomg(), dPOPnv_nomg, dPOPXiirl_ul_nomg, dPOPTOPnnrl_nomg, dPOPTOPiirl_ul_nomg dPOPTOPiirl_nomg, SvIV_please_nomg, SvNV_nomg (again, some of these were based on Father Chrysostomos's work). Fixed the list version of the repeat operator (x): it now only calls overloaded methods for the scalar version: (1,2,$overloaded) x 10 no longer erroneously calls x_method($overloaded,10)) The only thing I haven't checked/fixed yet is overloading the iterator operator, <>.
Diffstat (limited to 'gv.c')
-rw-r--r--gv.c96
1 files changed, 96 insertions, 0 deletions
diff --git a/gv.c b/gv.c
index 3412c9aa87..2d4cebc784 100644
--- a/gv.c
+++ b/gv.c
@@ -1818,6 +1818,99 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
}
+/* Implement tryAMAGICun_MG macro.
+ Do get magic, then see if the stack arg is overloaded and if so call it.
+ Flags:
+ AMGf_set return the arg using SETs rather than assigning to
+ the targ
+ AMGf_numeric apply sv_2num to the stack arg.
+*/
+
+bool
+Perl_try_amagic_un(pTHX_ int method, int flags) {
+ dVAR;
+ dSP;
+ SV* tmpsv;
+ SV* const arg = TOPs;
+
+ SvGETMAGIC(arg);
+
+ if (SvAMAGIC(arg) && (tmpsv = AMG_CALLun_var(arg,method))) {
+ if (flags & AMGf_set) {
+ SETs(tmpsv);
+ }
+ else {
+ dTARGET;
+ if (SvPADMY(TARG)) {
+ sv_setsv(TARG, tmpsv);
+ SETTARG;
+ }
+ else
+ SETs(tmpsv);
+ }
+ PUTBACK;
+ return TRUE;
+ }
+
+ if ((flags & AMGf_numeric) && SvROK(arg))
+ *sp = sv_2num(arg);
+ return FALSE;
+}
+
+
+/* Implement tryAMAGICbin_MG macro.
+ Do get magic, then see if the two stack args are overloaded and if so
+ call it.
+ Flags:
+ AMGf_set return the arg using SETs rather than assigning to
+ the targ
+ AMGf_assign op may be called as mutator (eg +=)
+ AMGf_numeric apply sv_2num to the stack arg.
+*/
+
+bool
+Perl_try_amagic_bin(pTHX_ int method, int flags) {
+ dVAR;
+ dSP;
+ SV* const left = TOPm1s;
+ SV* const right = TOPs;
+
+ SvGETMAGIC(left);
+ if (left != right)
+ SvGETMAGIC(right);
+
+ if (SvAMAGIC(left) || SvAMAGIC(right)) {
+ SV * const tmpsv = amagic_call(left, right, method,
+ ((flags & AMGf_assign) && opASSIGN ? AMGf_assign: 0));
+ if (tmpsv) {
+ if (flags & AMGf_set) {
+ (void)POPs;
+ SETs(tmpsv);
+ }
+ else {
+ dATARGET;
+ (void)POPs;
+ if (opASSIGN || SvPADMY(TARG)) {
+ sv_setsv(TARG, tmpsv);
+ SETTARG;
+ }
+ else
+ SETs(tmpsv);
+ }
+ PUTBACK;
+ return TRUE;
+ }
+ }
+ if (flags & AMGf_numeric) {
+ if (SvROK(left))
+ *(sp-1) = sv_2num(left);
+ if (SvROK(right))
+ *sp = sv_2num(right);
+ }
+ return FALSE;
+}
+
+
SV*
Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
{
@@ -2120,7 +2213,10 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
if (( (method + assignshift == off)
&& (assign || (method == inc_amg) || (method == dec_amg)))
|| force_cpy)
+ {
RvDEEPCP(left);
+ }
+
{
dSP;
BINOP myop;