summaryrefslogtreecommitdiff
path: root/gv.c
diff options
context:
space:
mode:
authorPerl 5 Porters <perl5-porters@africa.nicoh.com>1997-01-16 07:24:00 +1200
committerChip Salzenberg <chip@atlantic.net>1997-01-16 07:24:00 +1200
commit44a8e56aa037ed0f03f0506f6f85f5ed290c78e1 (patch)
treecb236761929c3161f91de24c86322902758b6efb /gv.c
parent8227f81cbd3d53a745747c4247824562383badae (diff)
downloadperl-44a8e56aa037ed0f03f0506f6f85f5ed290c78e1.tar.gz
[inseparable changes from patch from perl5.003_20 to perl5.003_21]
BUILD PROCESS Subject: Make MachTen hints file warn about db-recno failures Date: Wed, 8 Jan 1997 12:07:18 +0100 From: Dominic Dunlop <domo@slipper.ip.lu> Files: hints/machten.sh Msg-ID: <v03010d00aef92fba6aca@[194.51.248.78]> (applied based on p5p patch as commit a4c70ab8da3ec1d87c83e5c617f4550814ec1724) Subject: 5.003_20, FreeBSD 3.0 and minor patch Date: Wed, 8 Jan 1997 14:37:47 +0100 From: Ollivier Robert <roberto@eurocontrol.fr> Files: Configure Msg-ID: <Mutt.19970108143747.roberto@caerdonn.eurocontrol.fr> (applied based on p5p patch as commit 50e0d465254be88fb90ac23584812a529741b4b1) CORE LANGUAGE CHANGES Subject: Fix overloading via inherited autoloaded functions Date: Mon, 13 Jan 1997 05:22:47 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: gv.c lib/overload.pm pod/perldiag.pod t/pragma/overload.t Msg-ID: <199701131022.FAA22830@monk.mps.ohio-state.edu> (applied based on p5p patch as commit a9bc755754f0db5e848e65dfd2e63a96af50ffd4) Subject: Method call fixes: Don't cache in alias, don't skip undef From: Chip Salzenberg <chip@atlantic.net> Files: global.sym gv.c gv.h hv.c op.c pod/perlguts.pod pod/perltoc.pod pp.c pp_ctl.c pp_hot.c proto.h scope.c sv.c t/op/method.t Subject: Formats can be closures From: Chip Salzenberg <chip@atlantic.net> Files: cv.h op.c perly.c perly.c.diff perly.y pp_sys.c sv.h Subject: Quote 'foo' in C<$x{-foo}> From: Chip Salzenberg <chip@atlantic.net> Files: toke.c Subject: Forbid C< x->{y} > and C< x->[0] > under C<strict refs> From: Chip Salzenberg <chip@atlantic.net> Files: op.c pod/perldiag.pod t/pragma/strict-refs Subject: Allow <=> to return undef when operands are not ordered From: Chip Salzenberg <chip@perl.com> Files: MANIFEST pp.c t/op/cmp.t CORE PORTABILITY Subject: Re: Perl 5.003_20: OS/2 patches Date: Fri, 10 Jan 1997 06:02:16 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: hints/os2.sh os2/Changes os2/os2.c os2/os2ish.h pp_sys.c Msg-ID: <199701101102.GAA19051@monk.mps.ohio-state.edu> (applied based on p5p patch as commit 9a3e71f668bd84b1cf53dd3ea10f588d59ecfebb) Subject: VMS patches for _20 Date: Tue, 14 Jan 1997 17:34:43 -0500 (EST) From: Charles Bailey <bailey@HMIVAX.HUMGEN.UPENN.EDU> Files: configpm dosish.h os2/os2ish.h plan9/plan9ish.h proto.h t/pragma/strict.t t/pragma/subs.t t/pragma/warning.t toke.c unixish.h vms/Makefile vms/config.vms vms/descrip.mms vms/genconfig.pl vms/perly_c.vms vms/test.com vms/vmsish.h x2p/a2p.h x2p/str.c private-msgid: <01IE7MGK7ULQ003K5M@hmivax.humgen.upenn.edu> Subject: Irix 6.3 & 6.4 and perl5.003_20 Date: Mon, 13 Jan 1997 17:42:50 -0500 (EST) From: John Stoffel <jfs@fluent.com> Files: MANIFEST hints/irix_6_3.sh hints/irix_6_4.sh Msg-ID: <199701132242.RAA14601@jfs.Fluent.COM> (applied based on p5p patch as commit 8a1e91d771b51ae31eed1ac5944c63934213fb07) Subject: Patch: MachTen hints, Configure Date: Tue, 14 Jan 1997 13:43:13 +0100 From: Dominic Dunlop <domo@slipper.ip.lu> Files: Configure hints/machten.sh private-msgid: <v03010d00af0123a93670@[194.51.248.75]> Subject: Rename aux.sh to aux_3.sh for MS-LOSS From: Chip Salzenberg <chip@atlantic.net> Files: MANIFEST hints/aux_3.sh DOCUMENTATION Subject: Full documentation generation patch Date: Wed, 15 Jan 97 11:16:28 +0100 From: Raphael Manfredi <Raphael_Manfredi@grenoble.hp.com> Files: MANIFEST pod/roffitall pod/rofftoc Msg-ID: <15309.853323388@lyon.grenoble.hp.com> (applied based on p5p patch as commit a3270a1d7469cab9221ab0050a0e6695bd0047d8) Subject: Document use of pos() and /\G/ Date: Mon, 13 Jan 1997 15:13:12 -0500 From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: pod/perlfunc.pod pod/perlnews.pod pod/perlop.pod pod/perlre.pod pod/perltoc.pod pod/perltrap.pod Msg-ID: <199701132013.PAA26606@aatma.engin.umich.edu> (applied based on p5p patch as commit b2a07c1c241ec86f010fc0ea3bfa54c8ec28be90) Subject: Document new closure warnings From: Chip Salzenberg <chip@atlantic.net> Files: op.c pod/perldiag.pod Subject: Misc. doc patches missing in _20 Date: Tue, 07 Jan 1997 22:55:33 -0500 From: Roderick Schertler <roderick@gate.net> Files: pod/perlsub.pod pod/perltoc.pod pod/perlvar.pod Msg-ID: <102.852695733@eeyore.ibcinc.com> (applied based on p5p patch as commit b88f04ff2985d0899964b90ae56789d88f6b353e) LIBRARY AND EXTENSIONS Subject: Localize info about filesystems being case-forgiving From: Chip Salzenberg <chip@atlantic.net> Files: lib/File/Basename.pm pod/checkpods.PL pod/pod2html.PL pod/pod2latex.PL pod/pod2man.PL pod/pod2text.PL utils/c2ph.PL utils/h2ph.PL utils/h2xs.PL utils/perlbug.PL utils/perldoc.PL utils/pl2pm.PL utils/splain.PL x2p/find2perl.PL x2p/s2p.PL Subject: Eliminate warning from C<use overload> From: Chip Salzenberg <chip@atlantic.net> Files: lib/overload.pm OTHER CORE CHANGES Subject: Fix C< eval { my $x; eval '$x' } > From: Chip Salzenberg <chip@atlantic.net> Files: op.c t/op/misc.t Subject: Don't warn if eval '' uses outer func's lexicals From: Chip Salzenberg <chip@atlantic.net> Files: op.c Subject: Avoid memory wastage in wait(); make pidstatus global From: Chip Salzenberg <chip@atlantic.net> Files: global.sym interp.sym perl.c perl.h pp_sys.c Subject: Forbid ++ and -- on readonly values Date: Fri, 10 Jan 1997 19:47:16 -0800 (PST) From: "John Q. Linux" <jql@accessone.com> Files: pp.c pp_hot.c Msg-ID: <Pine.LNX.3.95.970110193330.11249D-100000@jql.accessone.com> (applied based on p5p patch as commit 74c80e585086695d5428ab316ca82fd6931aeabd) Subject: Keep array from dying during foreach(@array) From: Chip Salzenberg <chip@atlantic.net> Files: cop.h pp_ctl.c Subject: Fix C< $a="simple"; split /($a)/o > From: Chip Salzenberg <chip@atlantic.net> Files: pp.c t/op/misc.t Subject: Fix for anon-lists with tied entries coredump Date: Fri, 10 Jan 1997 02:45:11 -0500 From: Gurusamy Sarathy <gsar@engin.umich.edu> Files: pp.c Msg-ID: <199701100745.CAA13057@aatma.engin.umich.edu> (applied based on p5p patch as commit d976ac8220f8890bb7663152c4870f60e8e018c8) Subject: Don't set SVf_PADBUSY on immortal SVs From: Chip Salzenberg <chip@atlantic.net> Files: op.c Subject: Patch for Object subroutines Date: Tue, 7 Jan 1997 20:56:02 -0500 (EST) From: Ilya Zakharevich <ilya@math.ohio-state.edu> Files: cop.h Msg-ID: <199701080156.UAA15366@monk.mps.ohio-state.edu> (applied based on p5p patch as commit 174150afa5efdafc0e94a18211d3c9aa06b15cd9) Subject: Use an SVt_PVLV to hold stacked OP pointers when debugging From: Chip Salzenberg <chip@atlantic.net> Files: pp.c pp_hot.c Subject: Undo change that freed large pad vars From: Chip Salzenberg <chip@atlantic.net> Files: scope.c TESTS Subject: UNIVERSAL tests From: Roderick Schertler <roderick@gate.net> Files: MANIFEST t/op/universal.t Subject: Test deletion of array during foreach From: Jarkko Hietaniemi <jhi@alpha.hut.fi> Files: t/op/misc.t UTILITIES Subject: Don't search for pod if path is already valid Date: Wed, 08 Jan 1997 15:25:19 -0800 From: Wayne Scott <wscott@ichips.intel.com> Files: utils/perldoc.PL Msg-ID: <199701082325.PAA04521@pdxlx008.intel.com> (applied based on p5p patch as commit 88f0eda82bb679b4e6445ccb17e18d0781c6a5da) Subject: Yet another perldoc option Date: Thu, 3 Oct 1996 00:00:35 +0200 From: Gisle Aas <aas@aas.no> Files: utils/perldoc.PL Msg-ID: <199610022200.AAA15334@furubotn.sn.no> (applied based on p5p patch as commit a2333f3625faa17fb193cfa25c3d598cb59f105f) Subject: Re: perldoc, temp files, async pagers Date: 07 Jan 1997 22:54:14 -0500 From: Roderick Schertler <roderick@gate.net> Files: utils/perldoc.PL Msg-ID: <pzwwtoom8p.fsf@eeyore.ibcinc.com> (applied based on p5p patch as commit 7c36043de26da560a0f7eb04f36d232762c0092c)
Diffstat (limited to 'gv.c')
-rw-r--r--gv.c175
1 files changed, 126 insertions, 49 deletions
diff --git a/gv.c b/gv.c
index 5ffa11b02e..89533ff906 100644
--- a/gv.c
+++ b/gv.c
@@ -88,9 +88,8 @@ int multi;
sv_upgrade((SV*)gv, SVt_PVGV);
if (SvLEN(gv))
Safefree(SvPVX(gv));
- Newz(602,gp, 1, GP);
+ Newz(602, gp, 1, GP);
GvGP(gv) = gp_ref(gp);
- GvREFCNT(gv) = 1;
GvSV(gv) = NEWSV(72,0);
GvLINE(gv) = curcop->cop_line;
GvFILEGV(gv) = curcop->cop_filegv;
@@ -137,30 +136,28 @@ I32 level;
if (!stash)
return 0;
- if (level > 100)
+ if ((level > 100) || (level < -100))
croak("Recursive inheritance detected");
- gvp = (GV**)hv_fetch(stash, name, len, TRUE);
-
DEBUG_o( deb("Looking for method %s in package %s\n",name,HvNAME(stash)) );
- topgv = *gvp;
- if (SvTYPE(topgv) != SVt_PVGV)
- gv_init(topgv, stash, name, len, TRUE);
-
- if (cv = GvCV(topgv)) {
- if (CvXSUB(cv) || CvROOT(cv) || CvGV(cv)) { /* Not deleted, possibly autoloaded. */
- if (GvCVGEN(topgv) >= sub_generation)
- return topgv; /* valid cached inheritance */
- if (!GvCVGEN(topgv)) { /* not an inheritance cache */
+
+ gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
+ if (!gvp)
+ topgv = Nullgv;
+ else {
+ topgv = *gvp;
+ if (SvTYPE(topgv) != SVt_PVGV)
+ gv_init(topgv, stash, name, len, TRUE);
+ if (cv = GvCV(topgv)) {
+ /* If genuine method or valid cache entry, use it */
+ if (!GvCVGEN(topgv) || GvCVGEN(topgv) >= sub_generation)
return topgv;
- }
+ /* Stale cached entry: junk it */
+ SvREFCNT_dec(cv);
+ GvCV(topgv) = cv = Nullcv;
+ GvCVGEN(topgv) = 0;
}
- /* stale cached entry, just junk it */
- SvREFCNT_dec(cv);
- GvCV(topgv) = cv = 0;
- GvCVGEN(topgv) = 0;
}
- /* Now cv = 0, and there is no cv in topgv. */
gvp = (GV**)hv_fetch(stash,"ISA",3,FALSE);
if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) {
@@ -175,22 +172,25 @@ I32 level;
SvPVX(sv), HvNAME(stash));
continue;
}
- gv = gv_fetchmeth(basestash, name, len, level + 1);
- if (gv) {
- GvCV(topgv) = GvCV(gv); /* cache the CV */
- GvCVGEN(topgv) = sub_generation; /* valid for now */
- SvREFCNT_inc(GvCV(gv));
- return gv;
- }
+ gv = gv_fetchmeth(basestash, name, len,
+ (level >= 0) ? level + 1 : level - 1);
+ if (gv)
+ goto gotcha;
}
}
- if (!level) {
+ if (level == 0 || level == -1) {
if (lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE)) {
- if (gv = gv_fetchmeth(lastchance, name, len, level + 1)) {
- GvCV(topgv) = GvCV(gv); /* cache the CV */
- GvCVGEN(topgv) = sub_generation; /* valid for now */
- SvREFCNT_inc(GvCV(gv));
+ if (gv = gv_fetchmeth(lastchance, name, len,
+ (level >= 0) ? level + 1 : level - 1)) {
+ gotcha:
+ /* Use topgv for cache only if it has no synonyms */
+ if (topgv && GvREFCNT(topgv) == 1) {
+ if (cv = GvCV(topgv))
+ SvREFCNT_dec(cv);
+ GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
+ GvCVGEN(topgv) = sub_generation;
+ }
return gv;
}
}
@@ -271,22 +271,50 @@ char* name;
}
if (!gv) {
- CV* cv;
-
if (strEQ(name,"import"))
gv = (GV*)&sv_yes;
- else if (strNE(name, "AUTOLOAD")) {
- if (gv = gv_fetchmeth(stash, "AUTOLOAD", 8, 0)) {
- /* One more chance... */
- SV *tmpstr = sv_2mortal(newSVpv(HvNAME(stash),0));
- sv_catpvn(tmpstr,"::", 2);
- sv_catpvn(tmpstr, name, nend - name);
- cv = GvCV(gv);
- sv_setsv(GvSV(CvGV(cv)), tmpstr);
- SvTAINTED_off(GvSV(CvGV(cv)));
- }
- }
+ else
+ gv = gv_autoload(stash, name, nend - name);
}
+
+ return gv;
+}
+
+GV*
+gv_autoload(stash, name, len)
+HV* stash;
+char* name;
+STRLEN len;
+{
+ static char autoload[] = "AUTOLOAD";
+ static STRLEN autolen = 8;
+ GV* gv;
+ CV* cv;
+ HV* varstash;
+ GV* vargv;
+ SV* varsv;
+
+ if (len == autolen && strnEQ(name, autoload, autolen))
+ return Nullgv;
+ if (!(gv = gv_fetchmeth(stash, autoload, autolen, 0)))
+ return Nullgv;
+ cv = GvCV(gv);
+
+ /*
+ * Given &FOO::AUTOLOAD, set $FOO::AUTOLOAD to desired function name.
+ * The subroutine's original name may not be "AUTOLOAD", so we don't
+ * use that, but for lack of anything better we will use the sub's
+ * original package to look up $AUTOLOAD.
+ */
+ varstash = GvSTASH(CvGV(cv));
+ vargv = *(GV**)hv_fetch(varstash, autoload, autolen, TRUE);
+ if (!isGV(vargv))
+ gv_init(vargv, varstash, autoload, autolen, FALSE);
+ varsv = GvSV(vargv);
+ sv_setpv(varsv, HvNAME(stash));
+ sv_catpvn(varsv, "::", 2);
+ sv_catpvn(varsv, name, len);
+ SvTAINTED_off(varsv);
return gv;
}
@@ -796,8 +824,19 @@ gp_ref(gp)
GP* gp;
{
gp->gp_refcnt++;
+ if (gp->gp_cv) {
+ if (gp->gp_cvgen) {
+ /* multi-named GPs cannot be used for method cache */
+ SvREFCNT_dec(gp->gp_cv);
+ gp->gp_cv = Nullcv;
+ gp->gp_cvgen = 0;
+ }
+ else {
+ /* Adding a new name to a subroutine invalidates method cache */
+ sub_generation++;
+ }
+ }
return gp;
-
}
void
@@ -813,6 +852,10 @@ GV* gv;
warn("Attempt to free unreferenced glob pointers");
return;
}
+ if (gp->gp_cv) {
+ /* Deleting the name of a subroutine invalidates method cache */
+ sub_generation++;
+ }
if (--gp->gp_refcnt > 0) {
if (gp->gp_egv == gv)
gp->gp_egv = 0;
@@ -968,8 +1011,42 @@ HV* stash;
*buf = '('; /* A cooky: "(". */
strcpy(buf + 1, cp);
- gv = gv_fetchmeth(stash, buf, strlen(buf), 0); /* fills the stash! */
- if(gv && (cv = GvCV(gv))) filled = 1;
+ DEBUG_o( deb("Checking overloading of `%s' in package `%.256s'\n",
+ cp, HvNAME(stash)) );
+ gv = gv_fetchmeth(stash, buf, strlen(buf), -1); /* no filling stash! */
+ if(gv && (cv = GvCV(gv))) {
+ char *name = buf;
+ if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
+ && strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
+ /* GvSV contains the name of the method. */
+ GV *ngv;
+
+ DEBUG_o( deb("Resolving method `%.256s' for overloaded `%s' in package `%.256s'\n",
+ SvPV(GvSV(gv), na), cp, HvNAME(stash)) );
+ if (SvPOK(GvSV(gv))
+ && (ngv = gv_fetchmethod(stash, SvPVX(GvSV(gv))))) {
+ name = SvPVX(GvSV(gv));
+ cv = GvCV(gv = ngv);
+ } else {
+ /* Can be an import stub (created by `can'). */
+ if (GvCVGEN(gv)) {
+ croak("Stub found while resolving method `%.256s' overloading `%s' in package `%.256s'",
+ (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ),
+ cp, HvNAME(stash));
+ } else
+ croak("Cannot resolve method `%.256s' overloading `%s' in package `%.256s'",
+ (SvPOK(GvSV(gv)) ? SvPVX(GvSV(gv)) : "???" ),
+ cp, HvNAME(stash));
+ }
+ /* If the sub is only a stub then we may have a gv to AUTOLOAD */
+ gv = (GV*)*hv_fetch(GvSTASH(gv), name, strlen(name), TRUE);
+ cv = GvCV(gv);
+ }
+ DEBUG_o( deb("Overloading `%s' in package `%.256s' via `%.256s::%.256s' \n",
+ cp, HvNAME(stash), HvNAME(GvSTASH(CvGV(cv))),
+ GvNAME(CvGV(cv))) );
+ filled = 1;
+ }
#endif
amt.table[i]=(CV*)SvREFCNT_inc(cv);
}
@@ -1255,7 +1332,7 @@ int flags;
case dec_amg:
SvSetSV(left,res); return left;
case not_amg:
-ans=!SvOK(res); break;
+ ans=!SvOK(res); break;
}
return ans? &sv_yes: &sv_no;
} else if (method==copy_amg) {