summaryrefslogtreecommitdiff
path: root/pp_sys.c
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2000-08-30 19:26:55 +0100
committerJarkko Hietaniemi <jhi@iki.fi>2000-08-30 20:20:25 +0000
commita29a5827e4819998a9edff57b9f72c669b45ab63 (patch)
treee72d17f12df2f2ab01706b045c2f43c937bb7245 /pp_sys.c
parent32dba258d2586abb52f8cb398035fb44e123642e (diff)
downloadperl-a29a5827e4819998a9edff57b9f72c669b45ab63.tar.gz
Re: UNTIE method
Message-Id: <200008301726.SAA01114@mikado.tiuk.ti.com> p4raw-id: //depot/perl@6925
Diffstat (limited to 'pp_sys.c')
-rw-r--r--pp_sys.c20
1 files changed, 16 insertions, 4 deletions
diff --git a/pp_sys.c b/pp_sys.c
index a95c43c945..371c4a38ff 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -808,16 +808,28 @@ PP(pp_untie)
SV *sv = POPs;
char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) ? 'P' : 'q';
- if (ckWARN(WARN_UNTIE)) {
MAGIC * mg ;
if ((mg = SvTIED_mg(sv, how))) {
- if (mg && SvREFCNT(SvRV(mg->mg_obj)) > 1)
+ SV *obj = SvRV(mg->mg_obj);
+ GV *gv;
+ CV *cv = NULL;
+ if (ckWARN(WARN_UNTIE)) {
+ if (mg && SvREFCNT(obj) > 1)
Perl_warner(aTHX_ WARN_UNTIE,
"untie attempted while %"UVuf" inner references still exist",
- (UV)SvREFCNT(SvRV(mg->mg_obj)) - 1 ) ;
+ (UV)SvREFCNT(obj) - 1 ) ;
+ }
+ if ((gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE)) &&
+ isGV(gv) && (cv = GvCV(gv))) {
+ PUSHMARK(SP);
+ XPUSHs(SvTIED_obj((SV*)gv, mg));
+ PUTBACK;
+ ENTER;
+ call_sv((SV *)cv, G_VOID);
+ LEAVE;
+ SPAGAIN;
}
}
-
sv_unmagic(sv, how);
RETPUSHYES;
}