[perl.git] branch blead, updated. v5.25.3-258-gc82de78

[Father Chrysostomos]

In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/c82de78e3ba0184f85b5b49245e5da32d1cb3fcc?hp=e487ff5ee8f0cde894977f61d319c0c4e44aa0bd>

- Log -----------------------------------------------------------------
commit c82de78e3ba0184f85b5b49245e5da32d1cb3fcc
Author: Father Chrysostomos <spr...@cpan.org>
Date:   Mon Aug 15 18:09:17 2016 -0700

    [perl #126482] Fix assert fail ‘a_const a_const’
    
    Mentioning a constant twice in a row results in an assertion failure:
    
    $ ./miniperl -e 'sub ub(){0} ub ub'
    Assertion failed: (SvTYPE(cv) == SVt_PVCV || SvTYPE(cv) == SVt_PVFM), 
function Perl_cv_const_sv_or_av, file op.c, line 7926.
    Abort trap: 6
    
    A bisect points to 2eaf799e7, but I don’t understand why that commit
    introduced it.  I suspect it was failing an assertion for a slightly
    different reason back then, but am too lazy to check.
    
    In any case, it fails now because, while ‘ub ub’ is being compiled,
    when the sub is looked up initially (in toke.c:yylex), we call
    rv2cv_op_cv with the RV2GVOPCV_RETURN_STUB flag, which allows a
    bare constant ref to be returned.  So the ‘cv’ variable contains
    an RV (\0):
    
                        cv = lex
                            ? isGV(gv)
                                ? GvCV(gv)
                                : SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV
                                    ? (CV *)SvRV(gv)
                                    : ((CV *)gv)
                            : rv2cv_op_cv(rv2cv_op, RV2CVOPCV_RETURN_STUB);
    
    (‘ub’ here is a constant 0, which is stored in the symbol table as
    \0; i.e., ‘sub ub(){0}’ is equivalent to ‘BEGIN { $::{ub} = \0 }’.)
    
    Then if we see a word immediately following it (the second ‘ub’) we
    check a little further down to see whether it might be a method call.
    That entails calling intuit_method, which does this:
    
            indirgv = gv_fetchpvn_flags(tmpbuf, len, ( UTF ? SVf_UTF8 : 0 ), 
SVt_PVCV);
            if (indirgv && GvCVu(indirgv))
                return 0;
    
    So we are looking to see whether the second word refers to a sub and
    deciding this is not an indirect method call if there is a sub.
    
    But calling gv_fetchpvn_flags like that has the effect of upgrading
    the symbol table entry to a full GV.  Since the ‘cv’ variable in yylex
    points to that symbol table entry, it ends up pointing to a GV, which
    certain code later on does not expect to happen.
    
    So we should pass the GV_NOADD_NOINIT flag to gv_fetchpvn_flags to
    prevent lookup of the second bareword from upgrading the entry (we
    already do that earlier in intuit_method for the first bareword).  We
    only check the GV to see whether it has a sub or io thingy in it any-
    way, so we don’t actually need a full GV.  (As a bonus, GvIO will
    already work on a non-GV and return NULL, so that part of the code
    remains unchanged.)
-----------------------------------------------------------------------

Summary of changes:
 t/op/method.t | 6 +++++-
 toke.c        | 7 +++++--
 2 files changed, 10 insertions(+), 3 deletions(-)

diff --git a/t/op/method.t b/t/op/method.t
index a9666bb..596f869 100644
--- a/t/op/method.t
+++ b/t/op/method.t
@@ -13,7 +13,7 @@ BEGIN {
 use strict;
 no warnings 'once';
 
-plan(tests => 150);
+plan(tests => 151);
 
 @A::ISA = 'B';
 @B::ISA = 'C';
@@ -704,6 +704,10 @@ SKIP: {
                   "check unknown import() methods don't corrupt the stack");
 }
 
+like runperl(prog => 'sub ub(){0} ub ub', stderr=>1), qr/Bareword found/,
+ '[perl #126482] Assert failure when mentioning a constant twice in a row';
+
+
 __END__
 #FF9900
 #F78C08
diff --git a/toke.c b/toke.c
index 5e11253..b0e3736 100644
--- a/toke.c
+++ b/toke.c
@@ -4096,8 +4096,11 @@ S_intuit_method(pTHX_ char *start, SV *ioname, CV *cv)
            tmpbuf[len] = '\0';
            goto bare_package;
        }
-       indirgv = gv_fetchpvn_flags(tmpbuf, len, ( UTF ? SVf_UTF8 : 0 ), 
SVt_PVCV);
-       if (indirgv && GvCVu(indirgv))
+       indirgv = gv_fetchpvn_flags(tmpbuf, len,
+                                   GV_NOADD_NOINIT|( UTF ? SVf_UTF8 : 0 ),
+                                   SVt_PVCV);
+       if (indirgv && SvTYPE(indirgv) != SVt_NULL
+        && (!isGV(indirgv) || GvCVu(indirgv)))
            return 0;
        /* filehandle or package name makes it a method */
        if (!cv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, UTF ? SVf_UTF8 : 
0)) {

--
Perl5 Master Repository