diff options
author | Gurusamy Sarathy <gsar@cpan.org> | 2002-10-30 12:58:15 -0800 |
---|---|---|
committer | hv <hv@crypt.org> | 2002-11-19 11:48:30 +0000 |
commit | 0dae17bd7971d11b90a07b6fc03ec78ab38e4db4 (patch) | |
tree | bb9953708a3910f44e857da188d9d76096cc4231 /gv.c | |
parent | 8af2e859c733a1615cc8dbeb3491332ed702a779 (diff) | |
download | perl-0dae17bd7971d11b90a07b6fc03ec78ab38e4db4.tar.gz |
Re: [perl #18113] UNIVERSAL::AUTOLOAD doesn't work if the stash doesn't exist yet
Date: Wed, 30 Oct 2002 20:58:15 -0800
Message-Id: <200210310458.g9V4wFK00513@smtp3.ActiveState.com>
Date: Wed, 30 Oct 2002 21:56:22 -0800
Message-Id: <200210310556.g9V5uMK05748@smtp3.ActiveState.com>
Date: Wed, 30 Oct 2002 22:55:30 -0800
Message-Id: <200210310655.g9V6tUK10959@smtp3.ActiveState.com>
p4raw-id: //depot/perl@18159
Diffstat (limited to 'gv.c')
-rw-r--r-- | gv.c | 23 |
1 files changed, 18 insertions, 5 deletions
@@ -394,6 +394,10 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) register const char *nend; const char *nsplit = 0; GV* gv; + HV* ostash = stash; + + if (stash && SvTYPE(stash) < SVt_PVHV) + stash = Nullhv; for (nend = name; *nend; nend++) { if (*nend == '\'') @@ -426,6 +430,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) gv_stashpvn(origname, nsplit - origname - 7, FALSE)) stash = gv_stashpvn(origname, nsplit - origname, TRUE); } + ostash = stash; } gv = gv_fetchmeth(stash, name, nend - name, 0); @@ -433,7 +438,7 @@ Perl_gv_fetchmethod_autoload(pTHX_ HV *stash, const char *name, I32 autoload) if (strEQ(name,"import") || strEQ(name,"unimport")) gv = (GV*)&PL_sv_yes; else if (autoload) - gv = gv_autoload4(stash, name, nend - name, TRUE); + gv = gv_autoload4(ostash, name, nend - name, TRUE); } else if (autoload) { CV* cv = GvCV(gv); @@ -468,11 +473,19 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) HV* varstash; GV* vargv; SV* varsv; + char *packname = ""; - if (!stash) - return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */ if (len == autolen && strnEQ(name, autoload, autolen)) return Nullgv; + if (stash) { + if (SvTYPE(stash) < SVt_PVHV) { + packname = SvPV_nolen((SV*)stash); + stash = Nullhv; + } + else { + packname = HvNAME(stash); + } + } if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE))) return Nullgv; cv = GvCV(gv); @@ -487,7 +500,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) (GvCVGEN(gv) || GvSTASH(gv) != stash)) Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX), "Use of inherited AUTOLOAD for non-method %s::%.*s() is deprecated", - HvNAME(stash), (int)len, name); + packname, (int)len, name); if (CvXSUB(cv)) { /* rather than lookup/init $AUTOLOAD here @@ -515,7 +528,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method) gv_init(vargv, varstash, autoload, autolen, FALSE); LEAVE; varsv = GvSV(vargv); - sv_setpv(varsv, HvNAME(stash)); + sv_setpv(varsv, packname); sv_catpvn(varsv, "::", 2); sv_catpvn(varsv, name, len); SvTAINTED_off(varsv); |