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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (executable)
--- 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");
+}