Errno parsing: Skip expressions containing function names etc

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 2a13031..8585b7a 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1987,7 +1987,6 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
  *       a keyword (do this if the word is a label, e.g. goto FOO)
  *   int allow_pack : if true, : characters will also be allowed (require,
  *       use, etc. do this)
- *   int allow_initial_tick : used by the "sub" lexer only.
  */
 
 STATIC char *
@@ -2054,7 +2053,7 @@ S_force_ident(pTHX_ const char *s, int kind)
               warnings if the symbol must be introduced in an eval.
               GSAR 96-10-12 */
            gv_fetchpvn_flags(s, len,
-                             (PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL)
+                             (PL_in_eval ? GV_ADDMULTI
                              : GV_ADD) | ( UTF ? SVf_UTF8 : 0 ),
                              kind == '$' ? SVt_PV :
                              kind == '@' ? SVt_PVAV :
@@ -4128,7 +4127,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len)
     if (gv && GvCV(gv)) {
        SV * const sv = cv_const_sv(GvCV(gv));
        if (sv)
-            pkgname = SvPV_const(sv, len);
+           return gv_stashsv(sv, 0);
     }
 
     return gv_stashpvn(pkgname, len, UTF ? SVf_UTF8 : 0);
@@ -6215,7 +6214,7 @@ Perl_yylex(pTHX)
            }
            /* avoid v123abc() or $h{v1}, allow C<print v10;> */
            if (!isALPHA(*start) && (PL_expect == XTERM
-                       || PL_expect == XREF || PL_expect == XSTATE
+                       || PL_expect == XSTATE
                        || PL_expect == XTERMORDORDOR)) {
                GV *const gv = gv_fetchpvn_flags(s, start - s,
                                                     UTF ? SVf_UTF8 : 0, SVt_PVCV);
@@ -6474,10 +6473,6 @@ Perl_yylex(pTHX)
          just_a_word: {
                int pkgname = 0;
                const char lastchar = (PL_bufptr == PL_oldoldbufptr ? 0 : PL_bufptr[-1]);
-               const char penultchar =
-                   lastchar && PL_bufptr - 2 >= PL_linestart
-                        ? PL_bufptr[-2]
-                        : 0;
                bool safebw;
 
 
@@ -6556,7 +6551,11 @@ Perl_yylex(pTHX)
                    rv2cv_op =
                        newCVREF(OPpMAY_RETURN_CONSTANT<<8, const_op);
                    cv = lex
-                       ? isGV(gv) ? GvCV(gv) : (CV *)gv
+                       ? isGV(gv)
+                           ? GvCV(gv)
+                           : SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV
+                               ? (CV *)SvRV(gv)
+                               : (CV *)gv
                        : rv2cv_op_cv(rv2cv_op, RV2CVOPCV_RETURN_STUB);
                }
 
@@ -6611,13 +6610,17 @@ Perl_yylex(pTHX)
                if (*s == '=' && s[1] == '>' && !pkgname) {
                    op_free(rv2cv_op);
                    CLINE;
-                   /* This is our own scalar, created a few lines above,
-                      so this is safe. */
-                   SvREADONLY_off(cSVOPx(pl_yylval.opval)->op_sv);
-                   sv_setpv(((SVOP*)pl_yylval.opval)->op_sv, PL_tokenbuf);
-                   if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
-                     SvUTF8_on(((SVOP*)pl_yylval.opval)->op_sv);
-                   SvREADONLY_on(cSVOPx(pl_yylval.opval)->op_sv);
+                   if (gvp || (lex && !off)) {
+                       assert (cSVOPx(pl_yylval.opval)->op_sv == sv);
+                       /* This is our own scalar, created a few lines
+                          above, so this is safe. */
+                       SvREADONLY_off(sv);
+                       sv_setpv(sv, PL_tokenbuf);
+                       if (UTF && !IN_BYTES
+                        && is_utf8_string((U8*)PL_tokenbuf, len))
+                             SvUTF8_on(sv);
+                       SvREADONLY_on(sv);
+                   }
                    TERM(WORD);
                }
 
@@ -6681,14 +6684,6 @@ Perl_yylex(pTHX)
                /* Not a method, so call it a subroutine (if defined) */
 
                if (cv) {
-                   OP *gvop;
-                   if (lastchar == '-' && penultchar != '-') {
-                       const STRLEN l = len ? len : strlen(PL_tokenbuf);
-                       Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS),
-                           "Ambiguous use of -%"UTF8f" resolved as -&%"UTF8f"()",
-                            UTF8fARG(UTF, l, PL_tokenbuf),
-                            UTF8fARG(UTF, l, PL_tokenbuf));
-                    }
                    /* Check for a constant sub */
                    if ((sv = cv_const_sv_or_av(cv))) {
                  its_constant:
@@ -6706,20 +6701,6 @@ Perl_yylex(pTHX)
                        TOKEN(WORD);
                    }
 
-                   /* Resolve to GV now if this is a placeholder. */
-                   if (!off && (gvop = cUNOPx(rv2cv_op)->op_first)
-                    && gvop->op_type == OP_GV) {
-                       GV *gv2 = cGVOPx_gv(gvop);
-                       if (gv2 && !isGV(gv2)) {
-                           gv = gv_fetchpv(PL_tokenbuf, 0, SVt_PVCV);
-                           assert (SvTYPE(gv) == SVt_PVGV);
-                           /* cv must have been some sort of placeholder,
-                              so now needs replacing with a real code
-                              reference.  */
-                           cv = GvCV(gv);
-                       }
-                   }
-
                    op_free(pl_yylval.opval);
                    pl_yylval.opval =
                        off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op;
@@ -8169,10 +8150,7 @@ S_pending_ident(pTHX)
                 pl_yylval.opval->op_private = OPpCONST_ENTERED;
                 if (pit != '&')
                   gv_fetchsv(sym,
-                    (PL_in_eval
-                        ? (GV_ADDMULTI | GV_ADDINEVAL)
-                        : GV_ADDMULTI
-                    ),
+                    GV_ADDMULTI,
                     ((PL_tokenbuf[0] == '$') ? SVt_PV
                      : (PL_tokenbuf[0] == '@') ? SVt_PVAV
                      : SVt_PVHV));
@@ -8216,7 +8194,7 @@ S_pending_ident(pTHX)
     pl_yylval.opval->op_private = OPpCONST_ENTERED;
     if (pit != '&')
        gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
-                    (PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD)
+                    (PL_in_eval ? GV_ADDMULTI : GV_ADD)
                      | ( UTF ? SVf_UTF8 : 0 ),
                     ((PL_tokenbuf[0] == '$') ? SVt_PV
                      : (PL_tokenbuf[0] == '@') ? SVt_PVAV
@@ -8265,12 +8243,20 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
            s++;
        if (*s == ',') {
            GV* gv;
+           PADOFFSET off;
            if (keyword(w, s - w, 0))
                return;
 
            gv = gv_fetchpvn_flags(w, s - w, ( UTF ? SVf_UTF8 : 0 ), SVt_PVCV);
            if (gv && GvCVu(gv))
                return;
+           if (s - w <= 254) {
+               char tmpbuf[256];
+               Copy(w, tmpbuf+1, s - w, char);
+               *tmpbuf = '&';
+               off = pad_findmy_pvn(tmpbuf, s-w+1, UTF ? SVf_UTF8 : 0);
+               if (off != NOT_IN_PAD) return;
+           }
            Perl_croak(aTHX_ "No comma allowed after %s", what);
        }
     }
@@ -9242,7 +9228,8 @@ S_scan_heredoc(pTHX_ char *s)
        else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
            PL_bufend[-1] = '\n';
 #endif
-       if (*s == term && memEQ(s,PL_tokenbuf + 1,len)) {
+       if (*s == term && PL_bufend-s >= len
+        && memEQ(s,PL_tokenbuf + 1,len)) {
            SvREFCNT_dec(PL_linestr);
            PL_linestr = linestr_save;
            PL_linestart = SvPVX(linestr_save);
@@ -9391,9 +9378,7 @@ S_scan_inputsymbol(pTHX_ char *start)
                ++d;
 intro_sym:
                gv = gv_fetchpv(d,
-                               (PL_in_eval
-                                ? (GV_ADDMULTI | GV_ADDINEVAL)
-                                : GV_ADDMULTI) | ( UTF ? SVf_UTF8 : 0 ),
+                               GV_ADDMULTI | ( UTF ? SVf_UTF8 : 0 ),
                                SVt_PV);
                PL_lex_op = readline_overriden
                    ? (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,