From 611c1e95ac3070d4c5cdf44f47c6d9634aaaad72 Mon Sep 17 00:00:00 2001
From: Ilya Zakharevich <ilya@math.berkeley.edu>
Date: Tue, 26 Feb 2002 14:54:31 -0500
Subject: [PATCH] autoloaded DESTROY bugfix    Message-Id:
 <20020226195431.A9625@math.ohio-state.edu> p4raw-link: @14577 on
 //depot/perl: 0ad5258ff3f3328f321188cbb4fcd6a74b365431

p4raw-id: //depot/perl@14920
---
 embed.fnc          |  2 ++
 ext/B/B/Deparse.pm |  2 ++
 gv.c               | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 64 insertions(+), 2 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index a16b325..a94654f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -249,6 +249,8 @@ Ap	|void	|gv_efullname4	|SV* sv|GV* gv|const char* prefix|bool keepmain
 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
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index c8f0eb9..ec84a50 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -968,6 +968,8 @@ sub AUTOLOAD {
     }
 }
 
+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
diff --git a/gv.c b/gv.c
index 08a103c..aaf505c 100644
--- a/gv.c
+++ b/gv.c
@@ -310,6 +310,50 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 }
 
 /*
+=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 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 
 	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 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
 	    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);
     }
-- 
2.7.4