+/* 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 = amagic_call(arg, &PL_sv_undef, method,
+ AMGf_noright | AMGf_unary))) {
+ 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(left==right && SvGMAGICAL(left)) {
+ SV * const left = sv_newmortal();
+ *(sp-1) = left;
+ /* Print the uninitialized warning now, so it includes the vari-
+ able name. */
+ if (!SvOK(right)) {
+ if (ckWARN(WARN_UNINITIALIZED)) report_uninit(right);
+ sv_setsv_flags(left, &PL_sv_no, 0);
+ }
+ else sv_setsv_flags(left, right, 0);
+ SvGETMAGIC(right);
+ }
+ if (flags & AMGf_numeric) {
+ if (SvROK(TOPm1s))
+ *(sp-1) = sv_2num(TOPm1s);
+ if (SvROK(right))
+ *sp = sv_2num(right);
+ }
+ return FALSE;
+}
+
+SV *
+Perl_amagic_deref_call(pTHX_ SV *ref, int method) {
+ SV *tmpsv = NULL;
+
+ PERL_ARGS_ASSERT_AMAGIC_DEREF_CALL;
+
+ while (SvAMAGIC(ref) &&
+ (tmpsv = amagic_call(ref, &PL_sv_undef, method,
+ AMGf_noright | AMGf_unary))) {
+ if (!SvROK(tmpsv))
+ Perl_croak(aTHX_ "Overloaded dereference did not return a reference");
+ if (tmpsv == ref || SvRV(tmpsv) == SvRV(ref)) {
+ /* Bail out if it returns us the same reference. */
+ return tmpsv;
+ }
+ ref = tmpsv;
+ }
+ return tmpsv ? tmpsv : ref;
+}
+