diff options
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | perl.c | 3 | ||||
| -rw-r--r-- | pod/perlguts.pod | 7 | ||||
| -rw-r--r-- | pp_hot.c | 32 | ||||
| -rw-r--r-- | sv.c | 3 | ||||
| -rwxr-xr-x | t/op/method.t | 14 |
6 files changed, 43 insertions, 18 deletions
@@ -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; @@ -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 b71337c137..ad4c702b07 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) @@ -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"); @@ -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 0912f1e10a..1c6f3c5d9d 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"); +} |