This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Let rv2cv-hook CVs’ protos participate in method intuition
authorFather Chrysostomos <sprout@cpan.org>
Sun, 8 Jul 2012 06:22:33 +0000 (23:22 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 8 Jul 2012 07:24:10 +0000 (00:24 -0700)
Commit 39c012bc2fc2f1cf wasn’t enough.  If a subroutine has a proto-
type beginning with * then its name is treated as a sub call, even
when followed by a package name:

    {package Foo}
    sub Foo {}
    foo Foo; # Foo->foo

    {package Bar}
    sub bar (*) {}
    bar Bar; # bar(Bar)

This was not applying to subs looked up via rv2cv hooks.

ext/XS-APItest/t/sym-hook.t
toke.c

index 023aad9..25666f8 100644 (file)
@@ -4,7 +4,7 @@
 # So far we only test RV2CV.
 
 use XS::APItest;
-use Test::More tests => 3;
+use Test::More tests => 4;
 
 BEGIN {
     setup_rv2cv_addunderbar;
@@ -20,7 +20,13 @@ is(foo(), "phew");
 
 BEGIN { # If there is a foo symbol, this test will not be testing anything.
     delete $::{foo};
+    delete $::{goo};
 }
 is((foo bar), 'bar___');
 $bar = "baz";
 is((foo $bar), 'baz___');
+
+# Proto should cause goo() to override Foo->goo interpretation.
+{package Foom}
+sub goo_ (*) { shift . "===" }
+is((goo Foom), "Foom===");
diff --git a/toke.c b/toke.c
index c6e77b2..f4394b5 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -3760,11 +3760,9 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
 
     PERL_ARGS_ASSERT_INTUIT_METHOD;
 
-    if (gv) {
-       if (SvTYPE(gv) == SVt_PVGV && GvIO(gv))
+    if (gv && SvTYPE(gv) == SVt_PVGV && GvIO(gv))
            return 0;
-       if (cv) {
-           if (SvPOK(cv)) {
+    if (cv && SvPOK(cv)) {
                const char *proto = CvPROTO(cv);
                if (proto) {
                    if (*proto == ';')
@@ -3772,8 +3770,6 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
                    if (*proto == '*')
                        return 0;
                }
-           }
-       }
     }
     s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
     /* start is the beginning of the possible filehandle/object,