Increase default pipe buffer size on VMS to 8192 on 64-bit systems.

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

diff --git a/toke.c b/toke.c
index dfcb034..1398439 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -583,7 +583,7 @@ S_missingterm(pTHX_ char *s)
        ((0 != (PL_hints & HINT_LOCALIZE_HH))                           \
            && S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
 /* The longest string we pass in.  */
-#define MAX_FEATURE_LEN (sizeof("switch")-1)
+#define MAX_FEATURE_LEN (sizeof("unicode_strings")-1)
 
 /*
  * S_feature_is_enabled
@@ -1401,12 +1401,14 @@ chunk will not be discarded.
 =cut
 */
 
+#define LEX_NO_NEXT_CHUNK 0x80000000
+
 void
 Perl_lex_read_space(pTHX_ U32 flags)
 {
     char *s, *bufend;
     bool need_incline = 0;
-    if (flags & ~(LEX_KEEP_PREVIOUS))
+    if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK))
        Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_read_space");
 #ifdef PERL_MAD
     if (PL_skipwhite) {
@@ -1439,6 +1441,8 @@ Perl_lex_read_space(pTHX_ U32 flags)
            if (PL_madskills)
                sv_catpvn(PL_skipwhite, PL_parser->bufptr, s-PL_parser->bufptr);
 #endif /* PERL_MAD */
+           if (flags & LEX_NO_NEXT_CHUNK)
+               break;
            PL_parser->bufptr = s;
            CopLINE_inc(PL_curcop);
            got_more = lex_next_chunk(flags);
@@ -1714,20 +1718,12 @@ S_skipspace(pTHX_ register char *s)
     if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
        while (s < PL_bufend && SPACE_OR_TAB(*s))
            s++;
-    } else if (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE) {
-       while (isSPACE(*s) && *s != '\n')
-           s++;
-       if (*s == '#') {
-           do {
-               s++;
-           } while (s != PL_bufend && *s != '\n');
-       }
-       if (*s == '\n')
-           s++;
     } else {
        STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
        PL_bufptr = s;
-       lex_read_space(LEX_KEEP_PREVIOUS);
+       lex_read_space(LEX_KEEP_PREVIOUS |
+               (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
+                   LEX_NO_NEXT_CHUNK : 0));
        s = PL_bufptr;
        PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
        if (PL_linestart > PL_bufptr)
@@ -4363,7 +4359,8 @@ Perl_yylex(pTHX)
                    PL_doextract = FALSE;
                }
            }
-           incline(s);
+           if (PL_rsfp)
+               incline(s);
        } while (PL_doextract);
        PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
        PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
@@ -5641,8 +5638,6 @@ Perl_yylex(pTHX)
                    pl_yylval.ival = 0;
                OPERATOR(DOTDOT);
            }
-           if (PL_expect != XOPERATOR)
-               check_uni();
            Aop(OP_CONCAT);
        }
        /* FALL THROUGH */
@@ -6588,8 +6583,14 @@ Perl_yylex(pTHX)
 
        case KEY_eval:
            s = SKIPSPACE1(s);
-           PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
-           UNIBRACK(OP_ENTEREVAL);
+           if (*s == '{') { /* block eval */
+               PL_expect = XTERMBLOCK;
+               UNIBRACK(OP_ENTERTRY);
+           }
+           else { /* string eval */
+               PL_expect = XTERM;
+               UNIBRACK(OP_ENTEREVAL);
+           }
 
        case KEY_eof:
            UNI(OP_EOF);
@@ -7427,7 +7428,7 @@ Perl_yylex(pTHX)
                else if (*s != '{' && key == KEY_sub) {
                    if (!have_name)
                        Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
-                   else if (*s != ';')
+                   else if (*s != ';' && *s != '}')
                        Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, SVfARG(PL_subname));
                }
 
@@ -11366,7 +11367,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL
     char *bracket = NULL;
     char funny = *s++;
     register char *d = dest;
-    register char * const e = d + destlen + 3;    /* two-character token, ending NUL */
+    register char * const e = d + destlen - 3;    /* two-character token, ending NUL */
 
     PERL_ARGS_ASSERT_SCAN_IDENT;
 
@@ -13287,17 +13288,17 @@ S_swallow_bom(pTHX_ U8 *s)
     switch (s[0]) {
     case 0xFF:
        if (s[1] == 0xFE) {
-           /* UTF-16 little-endian? (or UTF32-LE?) */
+           /* UTF-16 little-endian? (or UTF-32LE?) */
            if (s[2] == 0 && s[3] == 0)  /* UTF-32 little-endian */
-               Perl_croak(aTHX_ "Unsupported script encoding UTF32-LE");
+               Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
 #ifndef PERL_NO_UTF16_FILTER
-           if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF16-LE script encoding (BOM)\n");
+           if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
            s += 2;
            if (PL_bufend > (char*)s) {
                s = add_utf16_textfilter(s, TRUE);
            }
 #else
-           Perl_croak(aTHX_ "Unsupported script encoding UTF16-LE");
+           Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
 #endif
        }
        break;
@@ -13310,7 +13311,7 @@ S_swallow_bom(pTHX_ U8 *s)
                s = add_utf16_textfilter(s, FALSE);
            }
 #else
-           Perl_croak(aTHX_ "Unsupported script encoding UTF16-BE");
+           Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
 #endif
        }
        break;
@@ -13325,15 +13326,19 @@ S_swallow_bom(pTHX_ U8 *s)
             if (s[1] == 0) {
                  if (s[2] == 0xFE && s[3] == 0xFF) {
                       /* UTF-32 big-endian */
-                      Perl_croak(aTHX_ "Unsupported script encoding UTF32-BE");
+                      Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE");
                  }
             }
             else if (s[2] == 0 && s[3] != 0) {
                  /* Leading bytes
                   * 00 xx 00 xx
                   * are a good indicator of UTF-16BE. */
+#ifndef PERL_NO_UTF16_FILTER
                  if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
-               s = add_utf16_textfilter(s, FALSE);
+                 s = add_utf16_textfilter(s, FALSE);
+#else
+                 Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
+#endif
             }
        }
 #ifdef EBCDIC
@@ -13350,8 +13355,12 @@ S_swallow_bom(pTHX_ U8 *s)
                  /* Leading bytes
                   * xx 00 xx 00
                   * are a good indicator of UTF-16LE. */
+#ifndef PERL_NO_UTF16_FILTER
              if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
              s = add_utf16_textfilter(s, TRUE);
+#else
+             Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
+#endif
         }
     }
     return (char*)s;