Change 14920 by ams@lustre on 2002/03/01 09:06:01
Subject: [PATCH @14577] autoloaded DESTROY bugfix
From: Ilya Zakharevich <[EMAIL PROTECTED]>
Date: Tue, 26 Feb 2002 19:54:31 -0500
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/embed.fnc#18 edit
.... //depot/perl/ext/B/B/Deparse.pm#111 edit
.... //depot/perl/gv.c#165 edit
Differences ...
==== //depot/perl/embed.fnc#18 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc.~1~ Fri Mar 1 02:15:05 2002
+++ perl/embed.fnc Fri Mar 1 02:15:05 2002
@@ -249,6 +249,8 @@
Ap |GV* |gv_fetchfile |const char* name
Apd |GV* |gv_fetchmeth |HV* stash|const char* name|STRLEN len \
|I32 level
+Apd |GV* |gv_fetchmeth_autoload |HV* stash|const char* name|STRLEN len \
+ |I32 level
Apd |GV* |gv_fetchmethod |HV* stash|const char* name
Apd |GV* |gv_fetchmethod_autoload|HV* stash|const char* name \
|I32 autoload
==== //depot/perl/ext/B/B/Deparse.pm#111 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm.~1~ Fri Mar 1 02:15:05 2002
+++ perl/ext/B/B/Deparse.pm Fri Mar 1 02:15:05 2002
@@ -968,6 +968,8 @@
}
}
+sub DESTROY {} # Do not AUTOLOAD
+
# $root should be the op which represents the root of whatever
# we're sequencing here. If it's undefined, then we don't append
# any subroutine declarations to the deparsed ops, otherwise we
==== //depot/perl/gv.c#165 (text) ====
Index: perl/gv.c
--- perl/gv.c.~1~ Fri Mar 1 02:15:05 2002
+++ perl/gv.c Fri Mar 1 02:15:05 2002
@@ -310,6 +310,50 @@
}
/*
+=for apidoc gv_fetchmeth_autoload
+
+Same as gv_fetchmeth(), but looks for autoloaded subroutines too.
+Returns a glob for the subroutine.
+
+For an autoloaded subroutine without a GV, will create a GV even
+if C<level < 0>. For an autoloaded subroutine without a stub, GvCV()
+of the result may be zero.
+
+=cut
+*/
+
+GV *
+Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
+{
+ GV *gv = gv_fetchmeth(stash, name, len, level);
+
+ if (!gv) {
+ char autoload[] = "AUTOLOAD";
+ STRLEN autolen = sizeof(autoload)-1;
+ CV *cv;
+ GV **gvp;
+
+ if (!stash)
+ return Nullgv; /* UNIVERSAL::AUTOLOAD could cause trouble */
+ if (len == autolen && strnEQ(name, autoload, autolen))
+ return Nullgv;
+ if (!(gv = gv_fetchmeth(stash, autoload, autolen, FALSE)))
+ return Nullgv;
+ cv = GvCV(gv);
+ if (!(CvROOT(cv) || CvXSUB(cv)))
+ return Nullgv;
+ /* Have an autoload */
+ if (level < 0) /* Cannot do without a stub */
+ gv_fetchmeth(stash, name, len, 0);
+ gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
+ if (!gvp)
+ return Nullgv;
+ return *gvp;
+ }
+ return gv;
+}
+
+/*
=for apidoc gv_fetchmethod
See L<gv_fetchmethod_autoload>.
@@ -1295,12 +1339,23 @@
DEBUG_o( Perl_deb(aTHX_ "Checking overloading of `%s' in package `%.256s'\n",
cp, HvNAME(stash)) );
- /* don't fill the cache while looking up! */
- gv = gv_fetchmeth(stash, cooky, l, -1);
+ /* don't fill the cache while looking up!
+ Creation of inheritance stubs in intermediate packages may
+ conflict with the logic of runtime method substitution.
+ Indeed, for inheritance A -> B -> C, if C overloads "+0",
+ then we could have created stubs for "(+0" in A and C too.
+ But if B overloads "bool", we may want to use it for
+ numifying instead of C's "+0". */
+ if (i >= DESTROY_amg)
+ gv = Perl_gv_fetchmeth_autoload(aTHX_ stash, cooky, l, 0);
+ else /* Autoload taken care of below */
+ gv = Perl_gv_fetchmeth(aTHX_ stash, cooky, l, -1);
cv = 0;
if (gv && (cv = GvCV(gv))) {
if (GvNAMELEN(CvGV(cv)) == 3 && strEQ(GvNAME(CvGV(cv)), "nil")
&& strEQ(HvNAME(GvSTASH(CvGV(cv))), "overload")) {
+ /* This is a hack to support autoloading..., while
+ knowing *which* methods were declared as overloaded. */
/* GvSV contains the name of the method. */
GV *ngv = Nullgv;
@@ -1328,6 +1383,9 @@
filled = 1;
if (i < DESTROY_amg)
have_ovl = 1;
+ } else if (gv) { /* Autoloaded... */
+ cv = (CV*)gv;
+ filled = 1;
}
amt.table[i]=(CV*)SvREFCNT_inc(cv);
}
End of Patch.
