summaryrefslogtreecommitdiff
path: root/sv.c
diff options
context:
space:
mode:
authorNick Ing-Simmons <nik@tiuk.ti.com>2001-06-15 11:08:13 +0000
committerNick Ing-Simmons <nik@tiuk.ti.com>2001-06-15 11:08:13 +0000
commit5f438a9a23e13957a6f27a6c29850d4dce382023 (patch)
tree5e4bafc239fedb2948b94b0cd4af3c2ccd6e9590 /sv.c
parent62472632dd6a4c4f7a44b090cbf3c9b176dafff0 (diff)
downloadperl-5f438a9a23e13957a6f27a6c29850d4dce382023.tar.gz
Check that HVs with HvNAME() != NULL are really stashes before
treating them as such. Also be more defensive on the GvCV. Win32 fork and dprof now working again. p4raw-id: //depot/perlio@10597
Diffstat (limited to 'sv.c')
-rw-r--r--sv.c34
1 files changed, 21 insertions, 13 deletions
diff --git a/sv.c b/sv.c
index 6b6e0636d8..4352fd4e79 100644
--- a/sv.c
+++ b/sv.c
@@ -8159,6 +8159,9 @@ Perl_sv_dup(pTHX_ SV *sstr)
}
HvPMROOT((HV*)dstr) = HvPMROOT((HV*)sstr); /* XXX */
HvNAME((HV*)dstr) = SAVEPV(HvNAME((HV*)sstr));
+ /* If HvNAME() is set hv _may_ be a stash
+ - record it for possible callback
+ */
if(HvNAME((HV*)dstr))
av_push(PL_clone_callbacks, dstr);
break;
@@ -9307,21 +9310,26 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
PL_ptr_table = NULL;
}
+ /* For the (possible) stashes identified above
+ - check that they are stashes
+ - if they are see if the ->CLONE method is defined
+ - if it is call it
+ */
while(av_len(PL_clone_callbacks) != -1) {
HV* stash = (HV*) av_shift(PL_clone_callbacks);
- CV* cloner = (CV*) gv_fetchmethod_autoload(stash,"CLONE",0);
- if(cloner) {
- dSP;
- cloner = GvCV(cloner);
- ENTER;
- SAVETMPS;
- PUSHMARK(SP);
- XPUSHs(newSVpv(HvNAME(stash),0));
- PUTBACK;
- call_sv((SV*)cloner, G_DISCARD);
- FREETMPS;
- LEAVE;
-
+ if (gv_stashpv(HvNAME(stash),0)) {
+ GV* cloner = gv_fetchmethod_autoload(stash,"CLONE",0);
+ if (cloner && GvCV(cloner)) {
+ dSP;
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+ XPUSHs(newSVpv(HvNAME(stash),0));
+ PUTBACK;
+ call_sv((SV*)GvCV(cloner), G_DISCARD);
+ FREETMPS;
+ LEAVE;
+ }
}
}