io/sem.t: eliminate warnings

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 8889449..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[] = {
@@ -1016,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))
@@ -1448,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");
@@ -2700,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;
 
@@ -7115,7 +7121,6 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s)
                 && !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)
                              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);
+                        return YYL_RETRY;
                     }
                 }
             }
@@ -7201,7 +7206,8 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s)
         TOKEN(';');
     }
 
-    return yyl_try(aTHX_ s);
+    PL_bufptr = s;
+    return YYL_RETRY;
 }
 
 static int
@@ -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;
@@ -8638,18 +8638,26 @@ 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);
+        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)
            }
            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)
                update_debugger_info(PL_linestr, NULL, 0);
            goto retry;
        }
-        return yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s);
+        if ((tok = yyl_fake_eof(aTHX_ 0, cBOOL(PL_rsfp), s)) != YYL_RETRY)
+            return tok;
+        goto retry_bufptr;
 
     case '\r':
 #ifdef PERL_STRICT_CR
@@ -9039,13 +9049,19 @@ yyl_try(pTHX_ char *s)
                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)
                }
            }
        }
-        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)
              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)
 int
 Perl_yylex(pTHX)
 {
-    dVAR;
     char *s = PL_bufptr;
 
     if (UNLIKELY(PL_parser->recheck_utf8_validity)) {
@@ -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;