diff options
| author | Abhijit Menon-Sen <ams@wiw.org> | 2001-06-18 21:20:32 +0530 |
|---|---|---|
| committer | Jarkko Hietaniemi <jhi@iki.fi> | 2001-06-18 11:56:12 +0000 |
| commit | f284b03f5001b3142d3bce4033dc8a2f11b9d3c6 (patch) | |
| tree | 0012f01b16e1e05d5a59e9a8a1e511b56fd38080 /sv.c | |
| parent | bd4dea8e97f4a8f5ea70abad87cc92cb8d32a865 (diff) | |
| download | perl-f284b03f5001b3142d3bce4033dc8a2f11b9d3c6.tar.gz | |
Re: [PATCH] more anonymous stash cleanups
Message-ID: <20010618155032.A13223@lustre.linux.in>
Plus the comment left in as suggested by NI-S.
p4raw-id: //depot/perl@10680
Diffstat (limited to 'sv.c')
| -rw-r--r-- | sv.c | 38 |
1 files changed, 16 insertions, 22 deletions
@@ -8159,9 +8159,7 @@ 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 - */ + /* Record stashes for possible cloning in Perl_clone_using(). */ if(HvNAME((HV*)dstr)) av_push(PL_clone_callbacks, dstr); break; @@ -9310,27 +9308,23 @@ 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 - */ + /* Call the ->CLONE method, if it exists, for each of the stashes + identified by sv_dup() above. + */ while(av_len(PL_clone_callbacks) != -1) { HV* stash = (HV*) av_shift(PL_clone_callbacks); - 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; - } - } + 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; + } } #ifdef PERL_OBJECT |