From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 11 May 1999 14:08:14 +0000 (+0000)
Subject: avoid creating spurious subroutine stubs on failed subroutine
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f6ec51f74c8ac3114d6ab404cd0d7ce83d50adc9;p=p5sagit%2Fp5-mst-13.2.git

avoid creating spurious subroutine stubs on failed subroutine
call and other places of sv_2cv() misuse; fixes problems with
failed subroutine calls "hiding" later attempts to lookup methods
in base classes

p4raw-id: //depot/perl@3388
---

diff --git a/gv.c b/gv.c
index b2941c3..df3e0e1 100644
--- a/gv.c
+++ b/gv.c
@@ -1075,7 +1075,7 @@ Gv_AMupdate(HV *stash)
               break;
             case SVt_PVGV:
               if (!(cv = GvCVu((GV*)sv)))
-                cv = sv_2cv(sv, &stash, &gv, TRUE);
+                cv = sv_2cv(sv, &stash, &gv, FALSE);
               break;
           }
           if (cv) filled=1;
diff --git a/perl.c b/perl.c
index a08b95e..09da668 100644
--- a/perl.c
+++ b/perl.c
@@ -1190,6 +1190,9 @@ perl_get_cv(const char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVCV);
     /* XXX unsafe for threads if eval_owner isn't held */
+    /* XXX this is probably not what they think they're getting.
+     * It has the same effect as "sub name;", i.e. just a forward
+     * declaration! */
     if (create && !GvCVu(gv))
     	return newSUB(start_subparse(FALSE, 0),
 		      newSVOP(OP_CONST, 0, newSVpv(name,0)),
diff --git a/pod/perlguts.pod b/pod/perlguts.pod
index b71337c..ad4c702 100644
--- a/pod/perlguts.pod
+++ b/pod/perlguts.pod
@@ -2426,9 +2426,10 @@ set and the variable does not exist then NULL is returned.
 
 =item perl_get_cv
 
-Returns the CV of the specified Perl sub.  If C<create> is set and the Perl
-variable does not exist then it will be created.  If C<create> is not
-set and the variable does not exist then NULL is returned.
+Returns the CV of the specified Perl subroutine.  If C<create> is set and
+the Perl subroutine does not exist then it will be declared (which has
+the same effect as saying C<sub name;>).  If C<create> is not
+set and the subroutine does not exist then NULL is returned.
 
 	CV*	perl_get_cv (const char* name, I32 create)
 
diff --git a/pp_hot.c b/pp_hot.c
index deb4985..5fa2bef 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2094,10 +2094,13 @@ PP(pp_entersub)
 	break;
     case SVt_PVGV:
 	if (!(cv = GvCVu((GV*)sv)))
-	    cv = sv_2cv(sv, &stash, &gv, TRUE);
-	if (cv)
-	    break;
-	DIE("Not a CODE reference");
+	    cv = sv_2cv(sv, &stash, &gv, FALSE);
+	if (!cv) {
+	    ENTER;
+	    SAVETMPS;
+	    goto try_autoload;
+	}
+	break;
     }
 
     ENTER;
@@ -2117,16 +2120,19 @@ PP(pp_entersub)
 	    cv = GvCV(gv);
 	}
 	/* should call AUTOLOAD now? */
-	else if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
-				   FALSE)))
-	{
-	    cv = GvCV(autogv);
-	}
-	/* sorry */
 	else {
-	    sub_name = sv_newmortal();
-	    gv_efullname3(sub_name, gv, Nullch);
-	    DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+try_autoload:
+	    if ((autogv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+				   FALSE)))
+	    {
+		cv = GvCV(autogv);
+	    }
+	    /* sorry */
+	    else {
+		sub_name = sv_newmortal();
+		gv_efullname3(sub_name, gv, Nullch);
+		DIE("Undefined subroutine &%s called", SvPVX(sub_name));
+	    }
 	}
 	if (!cv)
 	    DIE("Not a CODE reference");
diff --git a/sv.c b/sv.c
index 87c3755..d616b8e 100644
--- a/sv.c
+++ b/sv.c
@@ -4214,6 +4214,9 @@ sv_2cv(SV *sv, HV **st, GV **gvp, I32 lref)
 	    ENTER;
 	    tmpsv = NEWSV(704,0);
 	    gv_efullname3(tmpsv, gv, Nullch);
+	    /* XXX this is probably not what they think they're getting.
+	     * It has the same effect as "sub name;", i.e. just a forward
+	     * declaration! */
 	    newSUB(start_subparse(FALSE, 0),
 		   newSVOP(OP_CONST, 0, tmpsv),
 		   Nullop,
diff --git a/t/op/method.t b/t/op/method.t
index 0912f1e..1c6f3c5 100755
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -4,7 +4,7 @@
 # test method calls and autoloading.
 #
 
-print "1..46\n";
+print "1..49\n";
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -155,3 +155,15 @@ test(A->eee(), "new B: In A::eee, 4");	# Which sticks
 
 # this test added due to bug discovery
 test(defined(@{"unknown_package::ISA"}) ? "defined" : "undefined", "undefined");
+
+# test that failed subroutine calls don't affect method calls
+{
+    package A1;
+    sub foo { "foo" }
+    package A2;
+    @ISA = 'A1';
+    package main;
+    test(A2->foo(), "foo");
+    test(do { eval 'A2::foo()'; $@ ? 1 : 0}, 1);
+    test(A2->foo(), "foo");
+}