This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix our-sub method confusion
authorFather Chrysostomos <sprout@cpan.org>
Thu, 4 Sep 2014 06:33:48 +0000 (23:33 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 4 Sep 2014 15:27:31 +0000 (08:27 -0700)
‘our $foo’ creates a lexical alias to a global symbol.  That lexi-
cal alias is resolved during parsing.  For instance, if you have
‘our $foo; package bar; $foo’, the last $foo is translated by the
parser into a ‘main::foo’ constant, which is then used for sym-
bol lookup.

A similar thing happens with ‘our subs’.  In
‘our sub foo; package bar; foo()’, the foo() call is first translated
into main::foo, and then there are various checks to determine how to
handle this bareword.

Sometimes it is determined to be a method call, and that’s where
things go awry.  For this name transformation should only happen when
we are going to call this sub.  If the parser concludes that it is not
actually a sub call, then the original bareword as it appeared in the
source should be used.  But that is not what was happening.  As a con-
sequence, this code compiles down to F->main::f, rather than F->f.

use experimental "lexical_subs";
our sub f;
{package F}
f F;
__END__
Undefined subroutine &main::f called at - line 4.

And that it is actually doing a method call, not just f(F) can be dem-
onstrated by the fact that extra arguments can come after F without an
intervening comma:

use experimental "lexical_subs";
our sub f { warn "@_" };
{package F}
f F "g";
__END__
F g at - line 2.

And that inheritance works:

use experimental "lexical_subs";
@ISA = "Bar";
our sub f;
undef *f;
sub Bar'f { print "bark\n" }
{package F}
f F;
__END__
bark

This commit corrects the behaviour by discarding the translated
symbol and restoring the original bareword if it turns out it is a
method name.

t/op/lexsub.t
toke.c

index e37fba1..50472d9 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     *bar::is = *is;
     *bar::like = *like;
 }
-plan 130;
+plan 132;
 
 # -------------------- Errors with feature disabled -------------------- #
 
@@ -96,6 +96,18 @@ sub bar::c { 43 }
   # inlining this used to fail an assertion (parentheses necessary):
   is(const, 3, 'our sub pointing to "use constant" constant');
 }
+# our sub and method confusion
+sub F::h { 4242 }
+{
+  my $called;
+  our sub h { ++$called; 4343 };
+  is((h F),4242, 'our sub symbol translation does not affect meth names');
+  undef $called;
+  print "#";
+  print h F; # follows a different path through yylex to intuit_method
+  print "\n";
+  is $called, undef, 'our sub symbol translation & meth names after print'
+}
 
 # -------------------- state -------------------- #
 
diff --git a/toke.c b/toke.c
index f6d75df..2a13031 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -6662,6 +6662,15 @@ Perl_yylex(pTHX)
                        && (isIDFIRST_lazy_if(s,UTF) || *s == '$')
                        && (tmp = intuit_method(s, lex ? NULL : sv, cv))) {
                  method:
+                   if (lex && !off) {
+                       assert(cSVOPx(pl_yylval.opval)->op_sv == sv);
+                       SvREADONLY_off(sv);
+                       sv_setpvn(sv, PL_tokenbuf, len);
+                       if (UTF && !IN_BYTES
+                        && is_utf8_string((U8*)PL_tokenbuf, len))
+                           SvUTF8_on (sv);
+                       else SvUTF8_off(sv);
+                   }
                    op_free(rv2cv_op);
                    if (tmp == METHOD && !PL_lex_allbrackets &&
                            PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)