Make parser_free() be called slightly later,

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index 24accc6..d11cdcc 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -615,8 +615,7 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 
 /*
  * Perl_lex_start
- * Initialize variables.  Uses the Perl save_stack to save its state (for
- * recursive calls to the parser).
+ * Create a parser object and initialise its parser and lexer fields
  */
 
 void
@@ -641,6 +640,9 @@ Perl_lex_start(pTHX_ SV *line)
     parser->yyerrstatus = 0;
     parser->yychar = YYEMPTY;          /* Cause a token to be read.  */
 
+    /* on scope exit, free this parser and restore any outer one */
+    SAVEPARSER(parser);
+
     /* initialise lexer state */
 
     SAVEI32(PL_lex_state);
@@ -655,6 +657,7 @@ Perl_lex_start(pTHX_ SV *line)
        }
     }
     SAVEI32(PL_curforce);
+    PL_curforce = -1;
 #else
     if (PL_lex_state == LEX_KNOWNEXT) {
        I32 toke = PL_nexttoke;
@@ -712,6 +715,20 @@ Perl_lex_start(pTHX_ SV *line)
     PL_rsfp = 0;
 }
 
+
+/* delete a parser object */
+
+void
+Perl_parser_free(pTHX_  const yy_parser *parser)
+{
+    Safefree(parser->stack);
+    Safefree(parser->lex_brackstack);
+    Safefree(parser->lex_casestack);
+    PL_parser = parser->old_parser;
+    Safefree(parser);
+}
+
+
 /*
  * Perl_lex_end
  * Finalizer for lexing operations.  Must be called when the parser is
@@ -2646,7 +2663,8 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv)
      */
 
     if (*start == '$') {
-       if (gv || PL_last_lop_op == OP_PRINT || isUPPER(*PL_tokenbuf))
+       if (gv || PL_last_lop_op == OP_PRINT || PL_last_lop_op == OP_SAY ||
+               isUPPER(*PL_tokenbuf))
            return 0;
 #ifdef PERL_MAD
        len = start - SvPVX(PL_linestr);
@@ -2922,7 +2940,7 @@ S_readpipe_override(pTHX)
                && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
            ||
            ((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE))
-            && (gv_readpipe = *gvp) != (GV*)&PL_sv_undef
+            && (gv_readpipe = *gvp) && isGV_with_GP(gv_readpipe)
             && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)))
     {
        PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
@@ -3906,10 +3924,11 @@ Perl_yylex(pTHX)
 #endif
 #ifdef PERL_MAD
        PL_realtokenstart = -1;
-       s = SKIPSPACE0(s);
-#else
-       s++;
+       if (!PL_thiswhite)
+           PL_thiswhite = newSVpvs("");
+       sv_catpvn(PL_thiswhite, s, 1);
 #endif
+       s++;
        goto retry;
     case '#':
     case '\n':
@@ -5166,7 +5185,7 @@ Perl_yylex(pTHX)
                }
                if (!ogv &&
                    (gvp = (GV**)hv_fetch(PL_globalstash,PL_tokenbuf,len,FALSE)) &&
-                   (gv = *gvp) != (GV*)&PL_sv_undef &&
+                   (gv = *gvp) && isGV_with_GP(gv) &&
                    GvCVu(gv) && GvIMPORTED_CV(gv))
                {
                    ogv = gv;
@@ -6416,7 +6435,7 @@ Perl_yylex(pTHX)
 
        case KEY_readpipe:
            set_csh();
-           UNI(OP_BACKTICK);
+           UNIDOR(OP_BACKTICK);
 
        case KEY_rewinddir:
            UNI(OP_REWINDDIR);
@@ -6987,7 +7006,11 @@ S_pending_ident(pTHX)
     if (pit == '@' && PL_lex_state != LEX_NORMAL && !PL_lex_brackets) {
         GV *gv = gv_fetchpv(PL_tokenbuf+1, 0, SVt_PVAV);
         if ((!gv || ((PL_tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
-             && ckWARN(WARN_AMBIGUOUS))
+               && ckWARN(WARN_AMBIGUOUS)
+               /* DO NOT warn for @- and @+ */
+               && !( PL_tokenbuf[2] == '\0' &&
+                   ( PL_tokenbuf[1] == '-' || PL_tokenbuf[1] == '+' ))
+          )
         {
             /* Downgraded from fatal to warning 20000522 mjd */
             Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
@@ -10438,7 +10461,11 @@ S_checkcomma(pTHX_ const char *s, const char *name, const char *what)
            }
            while (isSPACE(*w))
                ++w;
-           if (!*w || !strchr(";|})]oaiuw!=", *w))     /* an advisory hack only... */
+           /* the list of chars below is for end of statements or
+            * block / parens, boolean operators (&&, ||, //) and branch
+            * constructs (or, and, if, until, unless, while, err, for).
+            * Not a very solid hack... */
+           if (!*w || !strchr(";&/|})]oaiuwef!=", *w))
                Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                            "%s (...) interpreted as function",name);
        }
@@ -11378,7 +11405,7 @@ S_scan_inputsymbol(pTHX_ char *start)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
                ||
                ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
-               && (gv_readline = *gvp) != (GV*)&PL_sv_undef
+                && (gv_readline = *gvp) && isGV_with_GP(gv_readline)
                && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
            readline_overriden = TRUE;
 
@@ -12212,7 +12239,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
     case 'v':
 vstring:
                sv = newSV(5); /* preallocate storage space */
-               s = scan_vstring(s,sv);
+               s = scan_vstring(s, PL_bufend, sv);
        break;
     }
 
@@ -12694,28 +12721,29 @@ vstring, as well as updating the passed in sv.
 Function must be called like
 
        sv = newSV(5);
-       s = scan_vstring(s,sv);
+       s = scan_vstring(s,e,sv);
 
+where s and e are the start and end of the string.
 The sv should already be large enough to store the vstring
 passed in, for performance reasons.
 
 */
 
 char *
-Perl_scan_vstring(pTHX_ const char *s, SV *sv)
+Perl_scan_vstring(pTHX_ const char *s, const char *e, SV *sv)
 {
     dVAR;
     const char *pos = s;
     const char *start = s;
     if (*pos == 'v') pos++;  /* get past 'v' */
-    while (pos < PL_bufend && (isDIGIT(*pos) || *pos == '_'))
+    while (pos < e && (isDIGIT(*pos) || *pos == '_'))
        pos++;
     if ( *pos != '.') {
        /* this may not be a v-string if followed by => */
        const char *next = pos;
-       while (next < PL_bufend && isSPACE(*next))
+       while (next < e && isSPACE(*next))
            ++next;
-       if ((PL_bufend - next) >= 2 && *next == '=' && next[1] == '>' ) {
+       if ((e - next) >= 2 && *next == '=' && next[1] == '>' ) {
            /* return string not v-string */
            sv_setpvn(sv,(char *)s,pos-s);
            return (char *)pos;
@@ -12755,13 +12783,13 @@ Perl_scan_vstring(pTHX_ const char *s, SV *sv)
            sv_catpvn(sv, (const char*)tmpbuf, tmpend - tmpbuf);
            if (!UNI_IS_INVARIANT(NATIVE_TO_UNI(rev)))
                 SvUTF8_on(sv);
-           if (pos + 1 < PL_bufend && *pos == '.' && isDIGIT(pos[1]))
+           if (pos + 1 < e && *pos == '.' && isDIGIT(pos[1]))
                 s = ++pos;
            else {
                 s = pos;
                 break;
            }
-           while (pos < PL_bufend && (isDIGIT(*pos) || *pos == '_'))
+           while (pos < e && (isDIGIT(*pos) || *pos == '_'))
                 pos++;
        }
        SvPOK_on(sv);