This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Treat a consecutive semicolons in a prototype as 1
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index 954ec33..0a16715 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -2114,7 +2114,7 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
  */
 
 STATIC char *
-S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
+S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack)
 {
     dVAR;
     char *s;
@@ -2125,12 +2125,16 @@ S_force_word(pTHX_ char *start, int token, int check_keyword, int allow_pack, in
     start = SKIPSPACE1(start);
     s = start;
     if (isIDFIRST_lazy_if(s,UTF) ||
-       (allow_pack && *s == ':') ||
-       (allow_initial_tick && *s == '\'') )
+       (allow_pack && *s == ':') )
     {
        s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, allow_pack, &len);
-       if (check_keyword && keyword(PL_tokenbuf, len, 0))
+       if (check_keyword) {
+         char *s2 = PL_tokenbuf;
+         if (allow_pack && len > 6 && strnEQ(s2, "CORE::", 6))
+           s2 += 6, len -= 6;
+         if (keyword(s2, len, 0))
            return start;
+       }
        start_force(PL_curforce);
        if (PL_madskills)
            curmad('X', newSVpvn(start,s-start));
@@ -3991,13 +3995,13 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
     if (gv && SvTYPE(gv) == SVt_PVGV && GvIO(gv))
            return 0;
     if (cv && SvPOK(cv)) {
-               const char *proto = CvPROTO(cv);
-               if (proto) {
-                   if (*proto == ';')
-                       proto++;
-                   if (*proto == '*')
-                       return 0;
-               }
+       const char *proto = CvPROTO(cv);
+       if (proto) {
+           while (*proto && (isSPACE(*proto) || *proto == ';'))
+               proto++;
+           if (*proto == '*')
+               return 0;
+       }
     }
 
     if (*start == '$') {
@@ -4552,12 +4556,12 @@ S_tokenize_use(pTHX_ int is_use, char *s) {
            force_next(WORD);
        }
        else if (*s == 'v') {
-           s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_word(s,WORD,FALSE,TRUE);
            s = force_version(s, FALSE);
        }
     }
     else {
-       s = force_word(s,WORD,FALSE,TRUE,FALSE);
+       s = force_word(s,WORD,FALSE,TRUE);
        s = force_version(s, FALSE);
     }
     pl_yylval.ival = is_use;
@@ -5549,7 +5553,7 @@ Perl_yylex(pTHX)
                s++;
 
            if (strnEQ(s,"=>",2)) {
-               s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
+               s = force_word(PL_bufptr,WORD,FALSE,FALSE);
                DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } );
                OPERATOR('-');          /* unary minus */
            }
@@ -5621,7 +5625,7 @@ Perl_yylex(pTHX)
                s++;
                s = SKIPSPACE1(s);
                if (isIDFIRST_lazy_if(s,UTF)) {
-                   s = force_word(s,METHOD,FALSE,TRUE,FALSE);
+                   s = force_word(s,METHOD,FALSE,TRUE);
                    TOKEN(ARROW);
                }
                else if (*s == '$')
@@ -5984,7 +5988,7 @@ Perl_yylex(pTHX)
                    d++;
                if (*d == '}') {
                    const char minus = (PL_tokenbuf[0] == '-');
-                   s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
+                   s = force_word(s + minus, WORD, FALSE, TRUE);
                    if (minus)
                        force_next('-');
                }
@@ -6936,8 +6940,7 @@ Perl_yylex(pTHX)
                else {
                    rv2cv_op = newOP(OP_PADANY, 0);
                    rv2cv_op->op_targ = off;
-                   rv2cv_op = (OP*)newCVREF(0, rv2cv_op);
-                   cv = (CV *)PAD_SV(off);
+                   cv = find_lexical_cv(off);
                }
                lex = TRUE;
                goto just_a_word;
@@ -7266,7 +7269,8 @@ Perl_yylex(pTHX)
                    }
 
                    op_free(pl_yylval.opval);
-                   pl_yylval.opval = rv2cv_op;
+                   pl_yylval.opval =
+                       off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op;
                    pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
                    PL_last_lop = PL_oldbufptr;
                    PL_last_lop_op = OP_ENTERSUB;
@@ -7362,7 +7366,8 @@ Perl_yylex(pTHX)
                        gv = gv_fetchpv(PL_tokenbuf, GV_ADD | ( UTF ? SVf_UTF8 : 0 ),
                                         SVt_PVCV);
                        op_free(pl_yylval.opval);
-                       pl_yylval.opval = rv2cv_op;
+                       pl_yylval.opval =
+                           off ? (OP *)newCVREF(0, rv2cv_op) : rv2cv_op;
                        pl_yylval.opval->op_private |= OPpENTERSUB_NOPAREN;
                        PL_last_lop = PL_oldbufptr;
                        PL_last_lop_op = OP_ENTERSUB;
@@ -7743,7 +7748,7 @@ Perl_yylex(pTHX)
 
        case KEY_dump:
            PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE,FALSE);
+           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_DUMP);
 
        case KEY_else:
@@ -7876,7 +7881,7 @@ Perl_yylex(pTHX)
 
        case KEY_goto:
            PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE,FALSE);
+           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_GOTO);
 
        case KEY_gmtime:
@@ -8002,7 +8007,7 @@ Perl_yylex(pTHX)
 
        case KEY_last:
            PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE,FALSE);
+           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_LAST);
        
        case KEY_lc:
@@ -8110,7 +8115,7 @@ Perl_yylex(pTHX)
 
        case KEY_next:
            PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE,FALSE);
+           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_NEXT);
 
        case KEY_ne:
@@ -8194,7 +8199,7 @@ Perl_yylex(pTHX)
            LOP(OP_PACK,XTERM);
 
        case KEY_package:
-           s = force_word(s,WORD,FALSE,TRUE,FALSE);
+           s = force_word(s,WORD,FALSE,TRUE);
            s = SKIPSPACE1(s);
            s = force_strict_version(s);
            PL_lex_expect = XBLOCK;
@@ -8297,7 +8302,7 @@ Perl_yylex(pTHX)
                    || (s = force_version(s, TRUE), *s == 'v'))
            {
                *PL_tokenbuf = '\0';
-               s = force_word(s,WORD,TRUE,TRUE,FALSE);
+               s = force_word(s,WORD,TRUE,TRUE);
                if (isIDFIRST_lazy_if(PL_tokenbuf,UTF))
                    gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf),
                                 GV_ADD | (UTF ? SVf_UTF8 : 0));
@@ -8322,7 +8327,7 @@ Perl_yylex(pTHX)
 
        case KEY_redo:
            PL_expect = XOPERATOR;
-           s = force_word(s,WORD,TRUE,FALSE,FALSE);
+           s = force_word(s,WORD,TRUE,FALSE);
            LOOPX(OP_REDO);
 
        case KEY_rename:
@@ -8463,7 +8468,7 @@ Perl_yylex(pTHX)
            checkcomma(s,PL_tokenbuf,"subroutine name");
            s = SKIPSPACE1(s);
            PL_expect = XTERM;
-           s = force_word(s,WORD,TRUE,TRUE,FALSE);
+           s = force_word(s,WORD,TRUE,TRUE);
            LOP(OP_SORT,XREF);
 
        case KEY_split:
@@ -8495,10 +8500,10 @@ Perl_yylex(pTHX)
          really_sub:
            {
                char * const tmpbuf = PL_tokenbuf + 1;
-               SSize_t tboffset = 0;
                expectation attrful;
                bool have_name, have_proto;
                const int key = tmp;
+                SV *format_name = NULL;
 
 #ifdef PERL_MAD
                SV *tmpwhite = 0;
@@ -8525,14 +8530,14 @@ Perl_yylex(pTHX)
 
                    PL_expect = XBLOCK;
                    attrful = XATTRBLOCK;
-                   /* remember buffer pos'n for later force_word */
-                   tboffset = s - PL_oldbufptr;
                    d = scan_word(s, tmpbuf, sizeof PL_tokenbuf - 1, TRUE,
                                  &len);
 #ifdef PERL_MAD
                    if (PL_madskills)
                        nametoke = newSVpvn_flags(s, d - s, SvUTF8(PL_linestr));
 #endif
+                    if (key == KEY_format)
+                       format_name = S_newSV_maybe_utf8(aTHX_ s, d - s);
                    *PL_tokenbuf = '&';
                    if (memchr(tmpbuf, ':', len) || key != KEY_sub
                     || pad_findmy_pvn(
@@ -8578,11 +8583,16 @@ Perl_yylex(pTHX)
 #ifdef PERL_MAD
                    PL_thistoken = subtoken;
                    s = d;
-                    PERL_UNUSED_VAR(tboffset);
 #else
-                   if (have_name)
-                       (void) force_word(PL_oldbufptr + tboffset, WORD,
-                                         FALSE, TRUE, TRUE);
+                   if (format_name) {
+                        start_force(PL_curforce);
+                        if (PL_madskills)
+                            curmad('X', newSVpvn(start,s-start));
+                        NEXTVAL_NEXTTOKE.opval
+                            = (OP*)newSVOP(OP_CONST,0, format_name);
+                        NEXTVAL_NEXTTOKE.opval->op_private |= OPpCONST_BARE;
+                        force_next(WORD);
+                    }
 #endif
                    PREBLOCK(FORMAT);
                }
Unnamed repository; edit this file 'description' to name the repository.