[perl.git] branch blead, updated. v5.21.3-442-ga14c24d

[Father Chrysostomos]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/a14c24d0aff00806bd26ad296c7dc8ed2aed3f0a?hp=a730e3f230f364cffe49370f816f975ae7c9c403>

- Log -----------------------------------------------------------------
commit a14c24d0aff00806bd26ad296c7dc8ed2aed3f0a
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Wed Sep 3 23:33:48 2014 -0700

    Fix our-sub method confusion
    
    ‘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.

M       t/op/lexsub.t
M       toke.c

commit 2578d12a1403dc84569782ef1290059d33317cab
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Wed Sep 3 23:27:36 2014 -0700

    toke.c: Combine two identical chunks via goto

M       toke.c
-----------------------------------------------------------------------

Summary of changes:
 t/op/lexsub.t | 14 +++++++++++++-
 toke.c        | 16 +++++++++++-----
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/t/op/lexsub.t b/t/op/lexsub.t
index e37fba1..50472d9 100644
--- a/t/op/lexsub.t
+++ b/t/op/lexsub.t
@@ -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 9c9731a..2a13031 100644
--- a/toke.c
+++ b/toke.c
@@ -6583,11 +6583,7 @@ Perl_yylex(pTHX)
 
                    if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') &&
                        (tmp = intuit_method(s, lex ? NULL : sv, cv))) {
-                       op_free(rv2cv_op);
-                       if (tmp == METHOD && !PL_lex_allbrackets &&
-                               PL_lex_fakeeof > LEX_FAKEEOF_LOWLOGIC)
-                           PL_lex_fakeeof = LEX_FAKEEOF_LOWLOGIC;
-                       return REPORT(tmp);
+                       goto method;
                    }
 
                    /* If not a declared subroutine, it's an indirect object. */
@@ -6665,6 +6661,16 @@ Perl_yylex(pTHX)
                if (tmp == 1 && !orig_keyword
                        && (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)

--
Perl5 Master Repository