sv.c - sv_2pv_flags: Fix double FETCH from tied overloaded scalar

When dealing with a tied scalar with get magic, and the FETCH method
returned a blessed reference with overloading magic (with "a" magic),
the tied scalar returned from the fetch was not copied prior to calling
the magic function as an argument, this would then cause the get magic
to be called again if the overloaded method happened to copy or
otherwise use the tied scalar. The solution is to copy the reference
prior to dispatching the overload call.

It looks like we have been testing for the double FETCH for some time,
without any good rationale, so this test merely changes things to expect
the desired count.

Author: demerphq

lib/overload.t

@@ -1906,7 +1906,7 @@ foreach my $op (qw(<=> == != < <= > >=)) {
 
 	# eval should do tie, overload on its arg before checking taint */
 	push @tests, [ '1;', 'eval q(eval %s); $@ =~ /Insecure/',
-		'("")', '("")', [ 1, 2, 0 ], 0 ];
+		'("")', '("")', [ 1, 1, 0 ], 0 ];
 
 
 	for my $sub (keys %subs) {

pod/perldelta.pod

@@ -395,6 +395,12 @@ Also, embedded C<NUL> characters are now allowed in the input.
 If locale collation is not enabled on the platform (C<LC_COLLATE>), the
 input is returned unchanged.
 
+=item *
+
+Double FETCH during stringification of tied scalars returning an
+overloaded object have been fixed. The FETCH method should only be
+called once, but prior to this release was actually called twice.
+
 =back
 
 =head1 Known Problems

sv.c

@@ -2830,21 +2830,28 @@ char *
 Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags)
 {
     char *s;
+    bool done_gmagic = FALSE;
 
     PERL_ARGS_ASSERT_SV_2PV_FLAGS;
 
     assert (SvTYPE(sv) != SVt_PVAV && SvTYPE(sv) != SVt_PVHV
          && SvTYPE(sv) != SVt_PVFM);
-    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC))
+    if (SvGMAGICAL(sv) && (flags & SV_GMAGIC)) {
         mg_get(sv);
+        done_gmagic = TRUE;
+    }
+
     if (SvROK(sv)) {
         if (SvAMAGIC(sv)) {
             SV *tmpstr;
+            SV *nsv= (SV *)sv;
             if (flags & SV_SKIP_OVERLOAD)
                 return NULL;
-            tmpstr = AMG_CALLunary(sv, string_amg);
+            if (done_gmagic)
+                nsv = sv_mortalcopy_flags(sv,0);
+            tmpstr = AMG_CALLunary(nsv, string_amg);
             TAINT_IF(tmpstr && SvTAINTED(tmpstr));
-            if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+            if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(nsv)))) {
                 /* Unwrap this:  */
                 /* char *pv = lp ? SvPV(tmpstr, *lp) : SvPV_nolen(tmpstr);
                  */