summaryrefslogtreecommitdiff
path: root/sv.c
diff options
context:
space:
mode:
authorYitzchak Scott-Thoennes <sthoenna@efn.org>2002-11-03 07:48:18 -0800
committerhv <hv@crypt.org>2002-11-07 13:21:15 +0000
commitb5ccf5f2cdb7415d32c161b40f11284c4f37fb57 (patch)
treeaa4834bbea85de1a7914b496055a73656e88652b /sv.c
parent479b2847c3fbb8fe8ee4a5811514a771839458c4 (diff)
downloadperl-b5ccf5f2cdb7415d32c161b40f11284c4f37fb57.tar.gz
Re: [perl #18038] DESTROY change in 5.8.0?
Message-ID: <CXbx9gzkgS8W092yn@efn.org> p4raw-id: //depot/perl@18121
Diffstat (limited to 'sv.c')
-rw-r--r--sv.c20
1 files changed, 17 insertions, 3 deletions
diff --git a/sv.c b/sv.c
index 48efa2e6f3..a6749866ab 100644
--- a/sv.c
+++ b/sv.c
@@ -26,7 +26,7 @@
#ifdef PERL_COPY_ON_WRITE
#define SV_COW_NEXT_SV(sv) INT2PTR(SV *,SvUVX(sv))
#define SV_COW_NEXT_SV_SET(current,next) SvUVX(current) = PTR2UV(next)
-/* This is a pessamistic view. Scalar must be purely a read-write PV to copy-
+/* This is a pessimistic view. Scalar must be purely a read-write PV to copy-
on-write. */
#define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \
@@ -4631,8 +4631,7 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
avoid incrementing the object refcount.
Note we cannot do this to avoid self-tie loops as intervening RV must
- have its REFCNT incremented to keep it in existence - instead we could
- special case them in sv_free() -- NI-S
+ have its REFCNT incremented to keep it in existence.
*/
if (!obj || obj == sv ||
@@ -4649,6 +4648,21 @@ Perl_sv_magicext(pTHX_ SV* sv, SV* obj, int how, MGVTBL *vtable,
mg->mg_obj = SvREFCNT_inc(obj);
mg->mg_flags |= MGf_REFCOUNTED;
}
+
+ /* Normal self-ties simply pass a null object, and instead of
+ using mg_obj directly, use the SvTIED_obj macro to produce a
+ new RV as needed. For glob "self-ties", we are tieing the PVIO
+ with an RV obj pointing to the glob containing the PVIO. In
+ this case, to avoid a reference loop, we need to weaken the
+ reference.
+ */
+
+ if (how == PERL_MAGIC_tiedscalar && SvTYPE(sv) == SVt_PVIO &&
+ obj && SvROK(obj) && GvIO(SvRV(obj)) == (IO*)sv)
+ {
+ sv_rvweaken(obj);
+ }
+
mg->mg_type = how;
mg->mg_len = namlen;
if (name) {