Fix for the IO::Scalar bug (I think).

At tie time break the loop but in a different place:
 A. Increment REFCNT of the RV involved in the self-tie
 B. Decrement REFCNT of the thing RV points to (e.g. the GV)
At mg_free time
 Break the connection between the RV and its referent
 so that we do not try and free it (again).

p4raw-id: //depot/perlio@16808

diff --git a/mg.c b/mg.c
index 63de612..299d1bb 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -359,8 +359,17 @@ Perl_mg_free(pTHX_ SV *sv)
            else if (mg->mg_len == HEf_SVKEY)
                SvREFCNT_dec((SV*)mg->mg_ptr);
        }
-       if (mg->mg_flags & MGf_REFCOUNTED)
-           SvREFCNT_dec(mg->mg_obj);
+       if (mg->mg_flags & MGf_REFCOUNTED) {
+           SV *obj = mg->mg_obj;
+           if (mg->mg_type == PERL_MAGIC_tiedscalar && SvROK(obj) &&
+               (SvRV(obj) == sv || GvIO(SvRV(obj)) == (IO *) sv)) {
+               /* We are already free'ing the self-tied thing
+                  so SvREFCNT_dec must not.
+                */
+               SvROK_off(obj);
+           }
+           SvREFCNT_dec(obj);
+       }
        Safefree(mg);
     }
     SvMAGIC(sv) = 0;

diff --git a/sv.c b/sv.c
index dd35da7..7d51f32 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -4479,6 +4479,15 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
     else {
        mg->mg_obj = SvREFCNT_inc(obj);
        mg->mg_flags |= MGf_REFCOUNTED;
+
+       /* Break self-tie loops */
+       if (how == PERL_MAGIC_tiedscalar && SvROK(obj) &&
+          (SvRV(obj) == sv || GvIO(SvRV(obj)) == (IO *) sv)) {
+           /* We have to have a REFCNT to obj, so drop REFCNT
+              of what if references instead
+            */
+           SvREFCNT_dec(SvRV(obj));
+       }
     }
     mg->mg_type = how;
     mg->mg_len = namlen;
@@ -5172,20 +5181,9 @@ Perl_sv_free(pTHX_ SV *sv)
     }
     ATOMIC_DEC_AND_TEST(refcount_is_zero, SvREFCNT(sv));
     if (!refcount_is_zero) {
-       if (SvREFCNT(sv) == 1) {
-           /* Break self-tie loops */
-           MAGIC *mg = 0;
-           SV *obj;
-           if (SvTYPE(sv) == SVt_PVGV)
-               sv = (SV *)GvIO(sv);
-           if (!sv || !SvMAGICAL(sv) || SvTYPE(sv) < SVt_PVMG)
-               return;
-            mg = SvTIED_mg(sv, PERL_MAGIC_tiedscalar);
-           if (mg && (obj = mg->mg_obj) && SvROK(obj) &&
-               (SvRV(obj) == sv || GvIO(SvRV(obj)) == (IO *) sv)) {
-               sv_unmagic(sv, PERL_MAGIC_tiedscalar);
-           }
-       }
+       /* Do not be tempted to test SvMAGIC here till scope.c
+          stops sharing MAGIC * between SVs
+        */
        return;
     }
 #ifdef DEBUGGING