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
io/sem.t: eliminate warnings
[perl5.git] / toke.c
diff --git a/toke.c b/toke.c
index a5df7ae..9dcc7c3 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -147,6 +147,15 @@ static const char* const ident_var_zero_multi_digit = "Numeric variables with mo
 #define LEX_INTERPCONST                 2 /* NOT USED */
 #define LEX_FORMLINE            1 /* expecting a format line               */
 
+/* returned to yyl_try() to request it to retry the parse loop, expected to only
+   be returned directly by yyl_fake_eof(), but functions that call yyl_fake_eof()
+   can also return it.
+
+   yylex (aka Perl_yylex) returns 0 on EOF rather than returning -1,
+   other token values are 258 or higher (see perly.h), so -1 should be
+   a safe value here.
+*/
+#define YYL_RETRY (-1)
 
 #ifdef DEBUGGING
 static const char* const lex_state_names[] = {
@@ -307,7 +316,6 @@ struct code {
 
 static const struct code no_code = { NULL, NULL, NULL, NULL, NULL, 0, FALSE };
 
-
 #ifdef DEBUGGING
 
 /* how to interpret the pl_yylval associated with the token */
@@ -1017,7 +1025,6 @@ function is more convenient.
 void
 Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
 {
-    dVAR;
     char *bufptr;
     PERL_ARGS_ASSERT_LEX_STUFF_PVN;
     if (flags & ~(LEX_STUFF_UTF8))
@@ -1449,7 +1456,6 @@ is encountered, an exception is generated.
 I32
 Perl_lex_peek_unichar(pTHX_ U32 flags)
 {
-    dVAR;
     char *s, *bufend;
     if (flags & ~(LEX_KEEP_PREVIOUS))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_peek_unichar");
@@ -2701,7 +2707,6 @@ Perl_get_and_check_backslash_N_name(pTHX_ const char* s,
     const char* context = s - 3;
     STRLEN context_len = e - context + 1; /* include all of \N{...} */
 
-    dVAR;
 
     PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME;
 
@@ -4259,7 +4264,7 @@ S_scan_const(pTHX_ char *start)
            } else if (PL_lex_inpat && SvIVX(PL_linestr) == '\'') {
                type = "q";
                typelen = 1;
-           } else  {
+           } else {
                type = "qq";
                typelen = 2;
            }
@@ -6594,9 +6599,10 @@ yyl_sglquote(pTHX_ char *s)
 }
 
 static int
-yyl_dblquote(pTHX_ char *s, STRLEN len)
+yyl_dblquote(pTHX_ char *s)
 {
     char *d;
+    STRLEN len;
     s = scan_str(s,FALSE,FALSE,FALSE,NULL);
     DEBUG_T( {
         if (s)
@@ -6890,7 +6896,7 @@ yyl_my(pTHX_ char *s, I32 my)
     OPERATOR(MY);
 }
 
-static int yyl_try(pTHX_ char*, STRLEN);
+static int yyl_try(pTHX_ char*);
 
 static bool
 yyl_eol_needs_semicolon(pTHX_ char **ps)
@@ -6940,7 +6946,7 @@ yyl_eol_needs_semicolon(pTHX_ char **ps)
 }
 
 static int
-yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
+yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s)
 {
     char *d;
 
@@ -7115,7 +7121,6 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
                 && !instr(s,"indir")
                 && instr(PL_origargv[0],"perl"))
             {
-                dVAR;
                 char **newargv;
 
                 *ipathend = '\0';
@@ -7182,13 +7187,13 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
                              we must not do it again */
                     {
                         SvPVCLEAR(PL_linestr);
-                        PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
+                        PL_bufptr = PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
                         PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
                         PL_last_lop = PL_last_uni = NULL;
                         PL_preambled = FALSE;
                         if (PERLDB_LINE_OR_SAVESRC)
                             (void)gv_fetchfile(PL_origfilename);
-                        return yyl_try(aTHX_ s, len);
+                        return YYL_RETRY;
                     }
                 }
             }
@@ -7201,7 +7206,8 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s, STRLEN len)
         TOKEN(';');
     }
 
-    return yyl_try(aTHX_ s, len);
+    PL_bufptr = s;
+    return YYL_RETRY;
 }
 
 static int
@@ -7587,7 +7593,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
     case KEY___END__:
         if (PL_rsfp && (!PL_in_eval || PL_tokenbuf[2] == 'D'))
             yyl_data_handle(aTHX);
-        return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s, len);
+        return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s);
 
     case KEY___SUB__:
         FUN0OP(CvCLONE(PL_compcv)
@@ -7669,12 +7675,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct
         UNI(OP_CALLER);
 
     case KEY_crypt:
-#ifdef FCRYPT
-        if (!PL_cryptseen) {
-            PL_cryptseen = TRUE;
-            init_des();
-        }
-#endif
+
         LOP(OP_CRYPT,XTERM);
 
     case KEY_chmod:
@@ -8505,7 +8506,6 @@ yyl_key_core(pTHX_ char *s, STRLEN len, struct code c)
 static int
 yyl_keylookup(pTHX_ char *s, GV *gv)
 {
-    dVAR;
     STRLEN len;
     bool anydelim;
     I32 key;
@@ -8634,22 +8634,30 @@ yyl_keylookup(pTHX_ char *s, GV *gv)
 }
 
 static int
-yyl_try(pTHX_ char *s, STRLEN len)
+yyl_try(pTHX_ char *s)
 {
     char *d;
     GV *gv = NULL;
+    int tok;
 
   retry:
     switch (*s) {
     default:
-        if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s))
-            return yyl_keylookup(aTHX_ s, gv);
+        if (UTF ? isIDFIRST_utf8_safe(s, PL_bufend) : isALNUMC(*s)) {
+            if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+                return tok;
+            goto retry_bufptr;
+        }
         yyl_croak_unrecognised(aTHX_ s);
 
     case 4:
     case 26:
         /* emulate EOF on ^D or ^Z */
-        return yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s, len);
+        if ((tok = yyl_fake_eof(aTHX_ LEX_FAKE_EOF, FALSE, s)) != YYL_RETRY)
+            return tok;
+    retry_bufptr:
+        s = PL_bufptr;
+        goto retry;
 
     case 0:
        if ((!PL_rsfp || PL_lex_inwhat)
@@ -8705,7 +8713,7 @@ yyl_try(pTHX_ char *s, STRLEN len)
            }
            if (PL_minus_E)
                sv_catpvs(PL_linestr,
-                         "use feature ':5." STRINGIFY(PERL_VERSION) "';");
+                         "use feature ':" STRINGIFY(PERL_REVISION) "." STRINGIFY(PERL_VERSION) "';");
            if (PL_minus_n || PL_minus_p) {
                sv_catpvs(PL_linestr, "LINE: while (<>) {"/*}*/);
                if (PL_minus_l)
@@ -8750,7 +8758,9 @@ yyl_try(pTHX_ char *s, STRLEN len)
                update_debugger_info(PL_linestr, NULL, 0);
            goto retry;
        }
-        return yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s, len);
+        if ((tok = yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s)) != YYL_RETRY)
+            return tok;
+        goto retry_bufptr;
 
     case '\r':
 #ifdef PERL_STRICT_CR
@@ -8835,7 +8845,7 @@ yyl_try(pTHX_ char *s, STRLEN len)
 
     case '=':
         if (s[1] == '=' && (s == PL_linestart || s[-1] == '\n')
-            && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), "====="))
+            && memBEGINs(s + 2, (STRLEN) (PL_bufend - (s + 2)), "====="))
         {
             s = vcs_conflict_marker(s + 7);
             goto retry;
@@ -8929,7 +8939,7 @@ yyl_try(pTHX_ char *s, STRLEN len)
 
     case '<':
         if (s[1] == '<' && (s == PL_linestart || s[-1] == '\n')
-            && memBEGINs(s+2, (STRLEN) (PL_bufend - (s+2)), "<<<<<"))
+            && memBEGINs(s + 2, (STRLEN) (PL_bufend - (s + 2)), "<<<<<"))
         {
             s = vcs_conflict_marker(s + 7);
             goto retry;
@@ -8938,7 +8948,7 @@ yyl_try(pTHX_ char *s, STRLEN len)
 
     case '>':
         if (s[1] == '>' && (s == PL_linestart || s[-1] == '\n')
-            && memBEGINs(s + 2, (STRLEN) (PL_bufend - s + 2), ">>>>>"))
+            && memBEGINs(s + 2, (STRLEN) (PL_bufend - (s + 2)), ">>>>>"))
         {
             s = vcs_conflict_marker(s + 7);
             goto retry;
@@ -9021,7 +9031,7 @@ yyl_try(pTHX_ char *s, STRLEN len)
         return yyl_sglquote(aTHX_ s);
 
     case '"':
-        return yyl_dblquote(aTHX_ s, len);
+        return yyl_dblquote(aTHX_ s);
 
     case '`':
         return yyl_backtick(aTHX_ s);
@@ -9039,13 +9049,19 @@ yyl_try(pTHX_ char *s, STRLEN len)
                TERM(THING);
            }
            else if ((*start == ':' && start[1] == ':')
-                 || (PL_expect == XSTATE && *start == ':'))
-                return yyl_keylookup(aTHX_ s, gv);
+                     || (PL_expect == XSTATE && *start == ':')) {
+                if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+                    return tok;
+                goto retry_bufptr;
+            }
            else if (PL_expect == XSTATE) {
                d = start;
                while (d < PL_bufend && isSPACE(*d)) d++;
-               if (*d == ':')
-                    return yyl_keylookup(aTHX_ s, gv);
+               if (*d == ':') {
+                    if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+                        return tok;
+                    goto retry_bufptr;
+                }
            }
            /* avoid v123abc() or $h{v1}, allow C<print v10;> */
            if (!isALPHA(*start) && (PL_expect == XTERM
@@ -9059,14 +9075,18 @@ yyl_try(pTHX_ char *s, STRLEN len)
                }
            }
        }
-        return yyl_keylookup(aTHX_ s, gv);
+        if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+            return tok;
+        goto retry_bufptr;
 
     case 'x':
        if (isDIGIT(s[1]) && PL_expect == XOPERATOR) {
            s++;
            Mop(OP_REPEAT);
        }
-        return yyl_keylookup(aTHX_ s, gv);
+        if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+            return tok;
+        goto retry_bufptr;
 
     case '_':
     case 'a': case 'A':
@@ -9095,7 +9115,9 @@ yyl_try(pTHX_ char *s, STRLEN len)
              case 'X':
     case 'y': case 'Y':
     case 'z': case 'Z':
-        return yyl_keylookup(aTHX_ s, gv);
+        if ((tok = yyl_keylookup(aTHX_ s, gv)) != YYL_RETRY)
+            return tok;
+        goto retry_bufptr;
     }
 }
 
@@ -9154,7 +9176,6 @@ yyl_try(pTHX_ char *s, STRLEN len)
 int
 Perl_yylex(pTHX)
 {
-    dVAR;
     char *s = PL_bufptr;
 
     if (UNLIKELY(PL_parser->recheck_utf8_validity)) {
@@ -9403,7 +9424,7 @@ Perl_yylex(pTHX)
            expecting an operator) have been a sigil.
         */
         bool expected_operator = (PL_expect == XOPERATOR);
-        int ret = yyl_try(aTHX_ s, 0);
+        int ret = yyl_try(aTHX_ s);
         switch (pl_yylval.ival) {
         case OP_BIT_AND:
         case OP_MODULO:
@@ -11319,7 +11340,7 @@ Perl_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int
     /* if we allocated too much space, give some back */
     if (SvCUR(sv) + 5 < SvLEN(sv)) {
        SvLEN_set(sv, SvCUR(sv) + 1);
-       SvPV_renew(sv, SvLEN(sv));
+       SvPV_shrink_to_cur(sv);
     }
 
     /* decide whether this is the first or second quoted string we've read
@@ -12758,7 +12779,6 @@ void
 Perl_wrap_keyword_plugin(pTHX_
     Perl_keyword_plugin_t new_plugin, Perl_keyword_plugin_t *old_plugin_p)
 {
-    dVAR;
 
     PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_WRAP_KEYWORD_PLUGIN;
Unnamed repository; edit this file 'description' to name the repository.