podcheck.t: Move hash declaration to earlier in file

[perl5.git] / toke.c

diff --git a/toke.c b/toke.c
index 3686162..5261c6c 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -224,6 +224,7 @@ static const char* const lex_state_names[] = {
  * LOOPX        : loop exiting command (goto, last, dump, etc)
  * FTST         : file test operator
  * FUN0         : zero-argument function
+ * FUN0OP       : zero-argument function, with its op created in this file
  * FUN1         : not used, except for not, which isn't a UNIOP
  * BOop         : bitwise or or xor
  * BAop         : bitwise and
@@ -254,6 +255,7 @@ static const char* const lex_state_names[] = {
 #define LOOPX(f) return (pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
 #define FTST(f)  return (pl_yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
 #define FUN0(f)  return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
+#define FUN0OP(f)  return (pl_yylval.opval=f, CLINE, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0OP))
 #define FUN1(f)  return (pl_yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
 #define BOop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
 #define BAop(f)  return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
@@ -346,6 +348,7 @@ static struct debug_tokens {
     { FORMAT,          TOKENTYPE_NONE,         "FORMAT" },
     { FUNC,            TOKENTYPE_OPNUM,        "FUNC" },
     { FUNC0,           TOKENTYPE_OPNUM,        "FUNC0" },
+    { FUNC0OP,         TOKENTYPE_OPVAL,        "FUNC0OP" },
     { FUNC0SUB,                TOKENTYPE_OPVAL,        "FUNC0SUB" },
     { FUNC1,           TOKENTYPE_OPNUM,        "FUNC1" },
     { FUNCMETH,                TOKENTYPE_OPVAL,        "FUNCMETH" },
@@ -1414,7 +1417,10 @@ Perl_lex_read_unichar(pTHX_ U32 flags)
     if (c != -1) {
        if (c == '\n')
            CopLINE_inc(PL_curcop);
-       PL_parser->bufptr += UTF8SKIP(PL_parser->bufptr);
+       if (UTF)
+           PL_parser->bufptr += UTF8SKIP(PL_parser->bufptr);
+       else
+           ++(PL_parser->bufptr);
     }
     return c;
 }
@@ -6020,14 +6026,6 @@ Perl_yylex(pTHX)
            PREREF('$');
        }
 
-       /* This kludge not intended to be bulletproof. */
-       if (PL_tokenbuf[1] == '[' && !PL_tokenbuf[2]) {
-           pl_yylval.opval = newSVOP(OP_CONST, 0,
-                                  newSViv(CopARYBASE_get(&PL_compiling)));
-           pl_yylval.opval->op_private = OPpCONST_ARYBASE;
-           TERM(THING);
-       }
-
        d = s;
        {
            const char tmp = *s;
@@ -6923,21 +6921,23 @@ Perl_yylex(pTHX)
            }
 
        case KEY___FILE__:
-           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
-                                       newSVpv(CopFILE(PL_curcop),0));
-           TERM(THING);
+           FUN0OP(
+               (OP*)newSVOP(OP_CONST, 0, newSVpv(CopFILE(PL_curcop),0))
+           );
 
        case KEY___LINE__:
-            pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
-                                    Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)));
-           TERM(THING);
+           FUN0OP(
+               (OP*)newSVOP(OP_CONST, 0,
+                   Perl_newSVpvf(aTHX_ "%"IVdf, (IV)CopLINE(PL_curcop)))
+           );
 
        case KEY___PACKAGE__:
-           pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+           FUN0OP(
+               (OP*)newSVOP(OP_CONST, 0,
                                        (PL_curstash
                                         ? newSVhek(HvNAME_HEK(PL_curstash))
-                                        : &PL_sv_undef));
-           TERM(THING);
+                                        : &PL_sv_undef))
+           );
 
        case KEY___DATA__:
        case KEY___END__: {
@@ -6981,12 +6981,6 @@ Perl_yylex(pTHX)
 #else
                    if (PerlLIO_setmode(PerlIO_fileno(PL_rsfp), O_TEXT) != -1) {
 #endif /* NETWARE */
-#ifdef PERLIO_IS_STDIO /* really? */
-#  if defined(__BORLANDC__)
-                       /* XXX see note in do_binmode() */
-                       ((FILE*)PL_rsfp)->flags &= ~_F_BIN;
-#  endif
-#endif
                        if (loc > 0)
                            PerlIO_seek(PL_rsfp, loc, 0);
                    }
@@ -7645,7 +7639,8 @@ Perl_yylex(pTHX)
                missingterm(NULL);
            PL_expect = XOPERATOR;
            if (SvCUR(PL_lex_stuff)) {
-               int warned = 0;
+               int warned_comma = !ckWARN(WARN_QW);
+               int warned_comment = warned_comma;
                d = SvPV_force(PL_lex_stuff, len);
                while (len) {
                    for (; isSPACE(*d) && len; --len, ++d)
@@ -7653,17 +7648,17 @@ Perl_yylex(pTHX)
                    if (len) {
                        SV *sv;
                        const char *b = d;
-                       if (!warned && ckWARN(WARN_QW)) {
+                       if (!warned_comma || !warned_comment) {
                            for (; !isSPACE(*d) && len; --len, ++d) {
-                               if (*d == ',') {
+                               if (!warned_comma && *d == ',') {
                                    Perl_warner(aTHX_ packWARN(WARN_QW),
                                        "Possible attempt to separate words with commas");
-                                   ++warned;
+                                   ++warned_comma;
                                }
-                               else if (*d == '#') {
+                               else if (!warned_comment && *d == '#') {
                                    Perl_warner(aTHX_ packWARN(WARN_QW),
                                        "Possible attempt to put comments in qw() list");
-                                   ++warned;
+                                   ++warned_comment;
                                }
                            }
                        }
@@ -8314,7 +8309,7 @@ S_pending_ident(pTHX)
                 yyerror(Perl_form(aTHX_ "No package name allowed for "
                                   "variable %s in \"our\"",
                                   PL_tokenbuf));
-            tmp = allocmy(PL_tokenbuf, tokenbuf_len, 0);
+            tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
         }
         else {
             if (has_colon)
@@ -8322,7 +8317,8 @@ S_pending_ident(pTHX)
                            PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
 
             pl_yylval.opval = newOP(OP_PADANY, 0);
-            pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len, 0);
+            pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
+                                                        UTF ? SVf_UTF8 : 0);
             return PRIVATEREF;
         }
     }
@@ -8341,7 +8337,8 @@ S_pending_ident(pTHX)
 
     if (!has_colon) {
        if (!PL_in_my)
-           tmp = pad_findmy(PL_tokenbuf, tokenbuf_len, 0);
+           tmp = pad_findmy_pvn(PL_tokenbuf, tokenbuf_len,
+                                    UTF ? SVf_UTF8 : 0);
         if (tmp != NOT_IN_PAD) {
             /* might be an "our" variable" */
             if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
@@ -9561,7 +9558,7 @@ S_scan_inputsymbol(pTHX_ char *start)
            /* try to find it in the pad for this block, otherwise find
               add symbol table ops
            */
-           const PADOFFSET tmp = pad_findmy(d, len, 0);
+           const PADOFFSET tmp = pad_findmy_pvn(d, len, UTF ? SVf_UTF8 : 0);
            if (tmp != NOT_IN_PAD) {
                if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
                    HV * const stash = PAD_COMPNAME_OURSTASH(tmp);