X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/8e720305f65b4f201f4aef0d72433f29360b876f..68cf6151323b2a224f5d3e28a47922726683ff63:/toke.c diff --git a/toke.c b/toke.c index 05ede22..ef215a5 100644 --- a/toke.c +++ b/toke.c @@ -588,18 +588,11 @@ S_missingterm(pTHX_ char *s) Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q); } -#define FEATURE_IS_ENABLED(name) \ - ((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("unicode_strings")-1) - /* - * S_feature_is_enabled * Check whether the named feature is enabled. */ -STATIC bool -S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen) +bool +Perl_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen) { dVAR; HV * const hinthv = GvHV(PL_hintgv); @@ -607,7 +600,8 @@ S_feature_is_enabled(pTHX_ const char *const name, STRLEN namelen) PERL_ARGS_ASSERT_FEATURE_IS_ENABLED; - assert(namelen <= MAX_FEATURE_LEN); + if (namelen > MAX_FEATURE_LEN) + return FALSE; memcpy(&he_name[8], name, namelen); return (hinthv && hv_exists(hinthv, he_name, 8 + namelen)); @@ -673,11 +667,15 @@ code in I comes first and must consist of complete lines of input, and I supplies the remainder of the source. The I parameter is reserved for future use, and must always -be zero. +be zero, except for one flag that is currently reserved for perl's internal +use. =cut */ +/* LEX_START_SAME_FILTER indicates that this is not a new file, so it + can share filters with the current parser. */ + void Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) { @@ -685,7 +683,7 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) const char *s = NULL; STRLEN len; yy_parser *parser, *oparser; - if (flags) + if (flags && flags != LEX_START_SAME_FILTER) Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_start"); /* create and initialise a parser */ @@ -714,7 +712,10 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags) parser->lex_state = LEX_NORMAL; parser->expect = XSTATE; parser->rsfp = rsfp; - parser->rsfp_filters = newAV(); + parser->rsfp_filters = + !(flags & LEX_START_SAME_FILTER) || !oparser + ? newAV() + : MUTABLE_AV(SvREFCNT_inc(oparser->rsfp_filters)); Newx(parser->lex_brackstack, 120, char); Newx(parser->lex_casestack, 12, char); @@ -1517,6 +1518,7 @@ S_incline(pTHX_ const char *s) const char *t; const char *n; const char *e; + line_t line_num; PERL_ARGS_ASSERT_INCLINE; @@ -1560,9 +1562,10 @@ S_incline(pTHX_ const char *s) if (*e != '\n' && *e != '\0') return; /* false alarm */ + line_num = atoi(n)-1; + if (t - s > 0) { const STRLEN len = t - s; -#ifndef USE_ITHREADS SV *const temp_sv = CopFILESV(PL_curcop); const char *cf; STRLEN tmplen; @@ -1617,19 +1620,35 @@ S_incline(pTHX_ const char *s) gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE); /* adjust ${"::_ 0) { + AV * const av2 = GvAVn(gv2); + SV **svp = AvARRAY(av) + start; + I32 l = (I32)line_num+1; + while (items--) + av_store(av2, l++, SvREFCNT_inc(*svp++)); + } + } } if (tmpbuf2 != smallbuf) Safefree(tmpbuf2); } if (tmpbuf != smallbuf) Safefree(tmpbuf); } -#endif CopFILE_free(PL_curcop); CopFILE_setn(PL_curcop, s, len); } - CopLINE_set(PL_curcop, atoi(n)-1); + CopLINE_set(PL_curcop, line_num); } #ifdef PERL_MAD @@ -2613,8 +2632,8 @@ S_scan_const(pTHX_ char *start) register char *d = SvPVX(sv); /* destination for copies */ bool dorange = FALSE; /* are we in a translit range? */ bool didrange = FALSE; /* did we just finish a range? */ - I32 has_utf8 = FALSE; /* Output constant is UTF8 */ - I32 this_utf8 = UTF; /* Is the source string assumed + bool has_utf8 = FALSE; /* Output constant is UTF8 */ + bool this_utf8 = cBOOL(UTF); /* Is the source string assumed to be UTF8? But, this can show as true when the source isn't utf8, as for example @@ -2834,7 +2853,7 @@ S_scan_const(pTHX_ char *start) /* likewise skip #-initiated comments in //x patterns */ else if (*s == '#' && PL_lex_inpat && - ((PMOP*)PL_lex_inpat)->op_pmflags & PMf_EXTENDED) { + ((PMOP*)PL_lex_inpat)->op_pmflags & RXf_PMf_EXTENDED) { while (s+1 < send && *s != '\n') *d++ = NATIVE_TO_NEED(has_utf8,*s++); } @@ -3093,7 +3112,9 @@ S_scan_const(pTHX_ char *start) * utf8 now, we save a whole pass in the regular expression * compiler. Once that code is changed so Unicode * semantics doesn't necessarily have to be in utf8, this - * block should be removed */ + * block should be removed. However, the code that parses + * the output of this would have to be changed to not + * necessarily expect utf8 */ if (!has_utf8) { SvCUR_set(sv, d - SvPVX_const(sv)); SvPOK_on(sv); @@ -3126,12 +3147,22 @@ S_scan_const(pTHX_ char *start) if (PL_lex_inpat) { - /* Pass through to the regex compiler unchanged. The - * reason we evaluated the number above is to make sure - * there wasn't a syntax error. */ + /* On non-EBCDIC platforms, pass through to the regex + * compiler unchanged. The reason we evaluated the + * number above is to make sure there wasn't a syntax + * error. But on EBCDIC we convert to native so + * downstream code can continue to assume it's native + */ s -= 5; /* Include the '\N{U+' */ +#ifdef EBCDIC + d += my_snprintf(d, e - s + 1 + 1, /* includes the } + and the \0 */ + "\\N{U+%X}", + (unsigned int) UNI_TO_NATIVE(uv)); +#else Copy(s, d, e - s + 1, char); /* 1 = include the } */ d += e - s + 1; +#endif } else { /* Not a pattern: convert the hex to string */ @@ -3225,10 +3256,13 @@ S_scan_const(pTHX_ char *start) } /* Convert first code point to hex, including the - * boiler plate before it */ + * boiler plate before it. For all these, we + * convert to native format so that downstream code + * can continue to assume the input is native */ output_length = my_snprintf(hex_string, sizeof(hex_string), - "\\N{U+%X", (unsigned int) uv); + "\\N{U+%X", + (unsigned int) UNI_TO_NATIVE(uv)); /* Make sure there is enough space to hold it */ d = off + SvGROW(sv, off @@ -3253,7 +3287,8 @@ S_scan_const(pTHX_ char *start) output_length = my_snprintf(hex_string, sizeof(hex_string), - ".%X", (unsigned int) uv); + ".%X", + (unsigned int) UNI_TO_NATIVE(uv)); d = off + SvGROW(sv, off + output_length @@ -3367,7 +3402,7 @@ S_scan_const(pTHX_ char *start) case 'c': s++; if (s < send) { - *d++ = grok_bslash_c(*s++, 1); + *d++ = grok_bslash_c(*s++, has_utf8, 1); } else { yyerror("Missing control char name in \\c"); @@ -3747,7 +3782,7 @@ S_intuit_method(pTHX_ char *start, GV *gv, CV *cv) #endif s = PEEKSPACE(s); if ((PL_bufend - s) >= 2 && *s == '=' && *(s+1) == '>') - return 0; /* no assumptions -- "=>" quotes bearword */ + return 0; /* no assumptions -- "=>" quotes bareword */ bare_package: start_force(PL_curforce); NEXTVAL_NEXTTOKE.opval = (OP*)newSVOP(OP_CONST, 0, @@ -3966,7 +4001,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len) /* * S_readpipe_override - * Check whether readpipe() is overriden, and generates the appropriate + * Check whether readpipe() is overridden, and generates the appropriate * optree, provided sublex_start() is called afterwards. */ STATIC void @@ -4332,7 +4367,7 @@ Perl_yylex(pTHX) if (PL_lex_brackets > 100) Renew(PL_lex_brackstack, PL_lex_brackets + 10, char); PL_lex_brackstack[PL_lex_brackets++] = - (next_type >> 16) & 0xff; + (char) ((next_type >> 16) & 0xff); } if (next_type & (2<<24)) PL_lex_allbrackets++; @@ -4757,7 +4792,13 @@ Perl_yylex(pTHX) *(U8*)s == 0xEF || *(U8*)s >= 0xFE || s[1] == 0)) { - bof = PerlIO_tell(PL_rsfp) == (Off_t)SvCUR(PL_linestr); + Off_t offset = (IV)PerlIO_tell(PL_rsfp); + bof = (offset == (Off_t)SvCUR(PL_linestr)); +#if defined(PERLIO_USING_CRLF) && defined(PERL_TEXTMODE_SCRIPTS) + /* offset may include swallowed CR */ + if (!bof) + bof = (offset == (Off_t)SvCUR(PL_linestr)+1); +#endif if (bof) { PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); s = swallow_bom((U8*)s); @@ -6512,7 +6553,7 @@ Perl_yylex(pTHX) } /* Look for a subroutine with this name in current package, - unless name is "Foo::", in which case Foo is a bearword + unless name is "Foo::", in which case Foo is a bareword (and a package name). */ if (len > 2 && !PL_madskills && @@ -6569,7 +6610,7 @@ Perl_yylex(pTHX) goto safe_bareword; { - OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc(sv)); + OP *const_op = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(sv)); const_op->op_private = OPpCONST_BARE; rv2cv_op = newCVREF(0, const_op); } @@ -7014,7 +7055,7 @@ Perl_yylex(pTHX) s += 2; d = s; s = scan_word(s, PL_tokenbuf, sizeof PL_tokenbuf, FALSE, &len); - if (!(tmp = keyword(PL_tokenbuf, len, 0))) + if (!(tmp = keyword(PL_tokenbuf, len, 1))) Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf); if (tmp < 0) tmp = -tmp; @@ -7058,12 +7099,6 @@ Perl_yylex(pTHX) UNI(OP_CHOP); case KEY_continue: - /* When 'use switch' is in effect, continue has a dual - life as a control operator. */ - { - if (!FEATURE_IS_ENABLED("switch")) - PREBLOCK(CONTINUE); - else { /* We have to disambiguate the two senses of "continue". If the next token is a '{' then treat it as the start of a continue block; @@ -7074,8 +7109,6 @@ Perl_yylex(pTHX) PREBLOCK(CONTINUE); else FUN0(OP_CONTINUE); - } - } case KEY_chdir: /* may use HOME */ @@ -7612,7 +7645,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) @@ -7620,17 +7654,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; } } } @@ -7661,7 +7695,7 @@ Perl_yylex(pTHX) missingterm(NULL); pl_yylval.ival = OP_STRINGIFY; if (SvIVX(PL_lex_stuff) == '\'') - SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should intepolate */ + SvIV_set(PL_lex_stuff, 0); /* qq'$foo' should interpolate */ TERM(sublex_start()); case KEY_qr: @@ -8281,7 +8315,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) @@ -8289,7 +8323,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; } } @@ -8308,7 +8343,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)) { @@ -8388,3399 +8424,6 @@ S_pending_ident(pTHX) return WORD; } -/* - * The following code was generated by perl_keyword.pl. - */ - -I32 -Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) -{ - dVAR; - - PERL_ARGS_ASSERT_KEYWORD; - - switch (len) - { - case 1: /* 5 tokens of length 1 */ - switch (name[0]) - { - case 'm': - { /* m */ - return KEY_m; - } - - case 'q': - { /* q */ - return KEY_q; - } - - case 's': - { /* s */ - return KEY_s; - } - - case 'x': - { /* x */ - return -KEY_x; - } - - case 'y': - { /* y */ - return KEY_y; - } - - default: - goto unknown; - } - - case 2: /* 18 tokens of length 2 */ - switch (name[0]) - { - case 'd': - if (name[1] == 'o') - { /* do */ - return KEY_do; - } - - goto unknown; - - case 'e': - if (name[1] == 'q') - { /* eq */ - return -KEY_eq; - } - - goto unknown; - - case 'g': - switch (name[1]) - { - case 'e': - { /* ge */ - return -KEY_ge; - } - - case 't': - { /* gt */ - return -KEY_gt; - } - - default: - goto unknown; - } - - case 'i': - if (name[1] == 'f') - { /* if */ - return KEY_if; - } - - goto unknown; - - case 'l': - switch (name[1]) - { - case 'c': - { /* lc */ - return -KEY_lc; - } - - case 'e': - { /* le */ - return -KEY_le; - } - - case 't': - { /* lt */ - return -KEY_lt; - } - - default: - goto unknown; - } - - case 'm': - if (name[1] == 'y') - { /* my */ - return KEY_my; - } - - goto unknown; - - case 'n': - switch (name[1]) - { - case 'e': - { /* ne */ - return -KEY_ne; - } - - case 'o': - { /* no */ - return KEY_no; - } - - default: - goto unknown; - } - - case 'o': - if (name[1] == 'r') - { /* or */ - return -KEY_or; - } - - goto unknown; - - case 'q': - switch (name[1]) - { - case 'q': - { /* qq */ - return KEY_qq; - } - - case 'r': - { /* qr */ - return KEY_qr; - } - - case 'w': - { /* qw */ - return KEY_qw; - } - - case 'x': - { /* qx */ - return KEY_qx; - } - - default: - goto unknown; - } - - case 't': - if (name[1] == 'r') - { /* tr */ - return KEY_tr; - } - - goto unknown; - - case 'u': - if (name[1] == 'c') - { /* uc */ - return -KEY_uc; - } - - goto unknown; - - default: - goto unknown; - } - - case 3: /* 29 tokens of length 3 */ - switch (name[0]) - { - case 'E': - if (name[1] == 'N' && - name[2] == 'D') - { /* END */ - return KEY_END; - } - - goto unknown; - - case 'a': - switch (name[1]) - { - case 'b': - if (name[2] == 's') - { /* abs */ - return -KEY_abs; - } - - goto unknown; - - case 'n': - if (name[2] == 'd') - { /* and */ - return -KEY_and; - } - - goto unknown; - - default: - goto unknown; - } - - case 'c': - switch (name[1]) - { - case 'h': - if (name[2] == 'r') - { /* chr */ - return -KEY_chr; - } - - goto unknown; - - case 'm': - if (name[2] == 'p') - { /* cmp */ - return -KEY_cmp; - } - - goto unknown; - - case 'o': - if (name[2] == 's') - { /* cos */ - return -KEY_cos; - } - - goto unknown; - - default: - goto unknown; - } - - case 'd': - if (name[1] == 'i' && - name[2] == 'e') - { /* die */ - return -KEY_die; - } - - goto unknown; - - case 'e': - switch (name[1]) - { - case 'o': - if (name[2] == 'f') - { /* eof */ - return -KEY_eof; - } - - goto unknown; - - case 'x': - if (name[2] == 'p') - { /* exp */ - return -KEY_exp; - } - - goto unknown; - - default: - goto unknown; - } - - case 'f': - if (name[1] == 'o' && - name[2] == 'r') - { /* for */ - return KEY_for; - } - - goto unknown; - - case 'h': - if (name[1] == 'e' && - name[2] == 'x') - { /* hex */ - return -KEY_hex; - } - - goto unknown; - - case 'i': - if (name[1] == 'n' && - name[2] == 't') - { /* int */ - return -KEY_int; - } - - goto unknown; - - case 'l': - if (name[1] == 'o' && - name[2] == 'g') - { /* log */ - return -KEY_log; - } - - goto unknown; - - case 'm': - if (name[1] == 'a' && - name[2] == 'p') - { /* map */ - return KEY_map; - } - - goto unknown; - - case 'n': - if (name[1] == 'o' && - name[2] == 't') - { /* not */ - return -KEY_not; - } - - goto unknown; - - case 'o': - switch (name[1]) - { - case 'c': - if (name[2] == 't') - { /* oct */ - return -KEY_oct; - } - - goto unknown; - - case 'r': - if (name[2] == 'd') - { /* ord */ - return -KEY_ord; - } - - goto unknown; - - case 'u': - if (name[2] == 'r') - { /* our */ - return KEY_our; - } - - goto unknown; - - default: - goto unknown; - } - - case 'p': - if (name[1] == 'o') - { - switch (name[2]) - { - case 'p': - { /* pop */ - return -KEY_pop; - } - - case 's': - { /* pos */ - return KEY_pos; - } - - default: - goto unknown; - } - } - - goto unknown; - - case 'r': - if (name[1] == 'e' && - name[2] == 'f') - { /* ref */ - return -KEY_ref; - } - - goto unknown; - - case 's': - switch (name[1]) - { - case 'a': - if (name[2] == 'y') - { /* say */ - return (all_keywords || FEATURE_IS_ENABLED("say") ? KEY_say : 0); - } - - goto unknown; - - case 'i': - if (name[2] == 'n') - { /* sin */ - return -KEY_sin; - } - - goto unknown; - - case 'u': - if (name[2] == 'b') - { /* sub */ - return KEY_sub; - } - - goto unknown; - - default: - goto unknown; - } - - case 't': - if (name[1] == 'i' && - name[2] == 'e') - { /* tie */ - return -KEY_tie; - } - - goto unknown; - - case 'u': - if (name[1] == 's' && - name[2] == 'e') - { /* use */ - return KEY_use; - } - - goto unknown; - - case 'v': - if (name[1] == 'e' && - name[2] == 'c') - { /* vec */ - return -KEY_vec; - } - - goto unknown; - - case 'x': - if (name[1] == 'o' && - name[2] == 'r') - { /* xor */ - return -KEY_xor; - } - - goto unknown; - - default: - goto unknown; - } - - case 4: /* 41 tokens of length 4 */ - switch (name[0]) - { - case 'C': - if (name[1] == 'O' && - name[2] == 'R' && - name[3] == 'E') - { /* CORE */ - return -KEY_CORE; - } - - goto unknown; - - case 'I': - if (name[1] == 'N' && - name[2] == 'I' && - name[3] == 'T') - { /* INIT */ - return KEY_INIT; - } - - goto unknown; - - case 'b': - if (name[1] == 'i' && - name[2] == 'n' && - name[3] == 'd') - { /* bind */ - return -KEY_bind; - } - - goto unknown; - - case 'c': - if (name[1] == 'h' && - name[2] == 'o' && - name[3] == 'p') - { /* chop */ - return -KEY_chop; - } - - goto unknown; - - case 'd': - if (name[1] == 'u' && - name[2] == 'm' && - name[3] == 'p') - { /* dump */ - return -KEY_dump; - } - - goto unknown; - - case 'e': - switch (name[1]) - { - case 'a': - if (name[2] == 'c' && - name[3] == 'h') - { /* each */ - return -KEY_each; - } - - goto unknown; - - case 'l': - if (name[2] == 's' && - name[3] == 'e') - { /* else */ - return KEY_else; - } - - goto unknown; - - case 'v': - if (name[2] == 'a' && - name[3] == 'l') - { /* eval */ - return KEY_eval; - } - - goto unknown; - - case 'x': - switch (name[2]) - { - case 'e': - if (name[3] == 'c') - { /* exec */ - return -KEY_exec; - } - - goto unknown; - - case 'i': - if (name[3] == 't') - { /* exit */ - return -KEY_exit; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 'f': - if (name[1] == 'o' && - name[2] == 'r' && - name[3] == 'k') - { /* fork */ - return -KEY_fork; - } - - goto unknown; - - case 'g': - switch (name[1]) - { - case 'e': - if (name[2] == 't' && - name[3] == 'c') - { /* getc */ - return -KEY_getc; - } - - goto unknown; - - case 'l': - if (name[2] == 'o' && - name[3] == 'b') - { /* glob */ - return KEY_glob; - } - - goto unknown; - - case 'o': - if (name[2] == 't' && - name[3] == 'o') - { /* goto */ - return KEY_goto; - } - - goto unknown; - - case 'r': - if (name[2] == 'e' && - name[3] == 'p') - { /* grep */ - return KEY_grep; - } - - goto unknown; - - default: - goto unknown; - } - - case 'j': - if (name[1] == 'o' && - name[2] == 'i' && - name[3] == 'n') - { /* join */ - return -KEY_join; - } - - goto unknown; - - case 'k': - switch (name[1]) - { - case 'e': - if (name[2] == 'y' && - name[3] == 's') - { /* keys */ - return -KEY_keys; - } - - goto unknown; - - case 'i': - if (name[2] == 'l' && - name[3] == 'l') - { /* kill */ - return -KEY_kill; - } - - goto unknown; - - default: - goto unknown; - } - - case 'l': - switch (name[1]) - { - case 'a': - if (name[2] == 's' && - name[3] == 't') - { /* last */ - return KEY_last; - } - - goto unknown; - - case 'i': - if (name[2] == 'n' && - name[3] == 'k') - { /* link */ - return -KEY_link; - } - - goto unknown; - - case 'o': - if (name[2] == 'c' && - name[3] == 'k') - { /* lock */ - return -KEY_lock; - } - - goto unknown; - - default: - goto unknown; - } - - case 'n': - if (name[1] == 'e' && - name[2] == 'x' && - name[3] == 't') - { /* next */ - return KEY_next; - } - - goto unknown; - - case 'o': - if (name[1] == 'p' && - name[2] == 'e' && - name[3] == 'n') - { /* open */ - return -KEY_open; - } - - goto unknown; - - case 'p': - switch (name[1]) - { - case 'a': - if (name[2] == 'c' && - name[3] == 'k') - { /* pack */ - return -KEY_pack; - } - - goto unknown; - - case 'i': - if (name[2] == 'p' && - name[3] == 'e') - { /* pipe */ - return -KEY_pipe; - } - - goto unknown; - - case 'u': - if (name[2] == 's' && - name[3] == 'h') - { /* push */ - return -KEY_push; - } - - goto unknown; - - default: - goto unknown; - } - - case 'r': - switch (name[1]) - { - case 'a': - if (name[2] == 'n' && - name[3] == 'd') - { /* rand */ - return -KEY_rand; - } - - goto unknown; - - case 'e': - switch (name[2]) - { - case 'a': - if (name[3] == 'd') - { /* read */ - return -KEY_read; - } - - goto unknown; - - case 'c': - if (name[3] == 'v') - { /* recv */ - return -KEY_recv; - } - - goto unknown; - - case 'd': - if (name[3] == 'o') - { /* redo */ - return KEY_redo; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 's': - switch (name[1]) - { - case 'e': - switch (name[2]) - { - case 'e': - if (name[3] == 'k') - { /* seek */ - return -KEY_seek; - } - - goto unknown; - - case 'n': - if (name[3] == 'd') - { /* send */ - return -KEY_send; - } - - goto unknown; - - default: - goto unknown; - } - - case 'o': - if (name[2] == 'r' && - name[3] == 't') - { /* sort */ - return KEY_sort; - } - - goto unknown; - - case 'q': - if (name[2] == 'r' && - name[3] == 't') - { /* sqrt */ - return -KEY_sqrt; - } - - goto unknown; - - case 't': - if (name[2] == 'a' && - name[3] == 't') - { /* stat */ - return -KEY_stat; - } - - goto unknown; - - default: - goto unknown; - } - - case 't': - switch (name[1]) - { - case 'e': - if (name[2] == 'l' && - name[3] == 'l') - { /* tell */ - return -KEY_tell; - } - - goto unknown; - - case 'i': - switch (name[2]) - { - case 'e': - if (name[3] == 'd') - { /* tied */ - return -KEY_tied; - } - - goto unknown; - - case 'm': - if (name[3] == 'e') - { /* time */ - return -KEY_time; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 'w': - switch (name[1]) - { - case 'a': - switch (name[2]) - { - case 'i': - if (name[3] == 't') - { /* wait */ - return -KEY_wait; - } - - goto unknown; - - case 'r': - if (name[3] == 'n') - { /* warn */ - return -KEY_warn; - } - - goto unknown; - - default: - goto unknown; - } - - case 'h': - if (name[2] == 'e' && - name[3] == 'n') - { /* when */ - return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_when : 0); - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 5: /* 39 tokens of length 5 */ - switch (name[0]) - { - case 'B': - if (name[1] == 'E' && - name[2] == 'G' && - name[3] == 'I' && - name[4] == 'N') - { /* BEGIN */ - return KEY_BEGIN; - } - - goto unknown; - - case 'C': - if (name[1] == 'H' && - name[2] == 'E' && - name[3] == 'C' && - name[4] == 'K') - { /* CHECK */ - return KEY_CHECK; - } - - goto unknown; - - case 'a': - switch (name[1]) - { - case 'l': - if (name[2] == 'a' && - name[3] == 'r' && - name[4] == 'm') - { /* alarm */ - return -KEY_alarm; - } - - goto unknown; - - case 't': - if (name[2] == 'a' && - name[3] == 'n' && - name[4] == '2') - { /* atan2 */ - return -KEY_atan2; - } - - goto unknown; - - default: - goto unknown; - } - - case 'b': - switch (name[1]) - { - case 'l': - if (name[2] == 'e' && - name[3] == 's' && - name[4] == 's') - { /* bless */ - return -KEY_bless; - } - - goto unknown; - - case 'r': - if (name[2] == 'e' && - name[3] == 'a' && - name[4] == 'k') - { /* break */ - return (all_keywords || FEATURE_IS_ENABLED("switch") ? -KEY_break : 0); - } - - goto unknown; - - default: - goto unknown; - } - - case 'c': - switch (name[1]) - { - case 'h': - switch (name[2]) - { - case 'd': - if (name[3] == 'i' && - name[4] == 'r') - { /* chdir */ - return -KEY_chdir; - } - - goto unknown; - - case 'm': - if (name[3] == 'o' && - name[4] == 'd') - { /* chmod */ - return -KEY_chmod; - } - - goto unknown; - - case 'o': - switch (name[3]) - { - case 'm': - if (name[4] == 'p') - { /* chomp */ - return -KEY_chomp; - } - - goto unknown; - - case 'w': - if (name[4] == 'n') - { /* chown */ - return -KEY_chown; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 'l': - if (name[2] == 'o' && - name[3] == 's' && - name[4] == 'e') - { /* close */ - return -KEY_close; - } - - goto unknown; - - case 'r': - if (name[2] == 'y' && - name[3] == 'p' && - name[4] == 't') - { /* crypt */ - return -KEY_crypt; - } - - goto unknown; - - default: - goto unknown; - } - - case 'e': - if (name[1] == 'l' && - name[2] == 's' && - name[3] == 'i' && - name[4] == 'f') - { /* elsif */ - return KEY_elsif; - } - - goto unknown; - - case 'f': - switch (name[1]) - { - case 'c': - if (name[2] == 'n' && - name[3] == 't' && - name[4] == 'l') - { /* fcntl */ - return -KEY_fcntl; - } - - goto unknown; - - case 'l': - if (name[2] == 'o' && - name[3] == 'c' && - name[4] == 'k') - { /* flock */ - return -KEY_flock; - } - - goto unknown; - - default: - goto unknown; - } - - case 'g': - if (name[1] == 'i' && - name[2] == 'v' && - name[3] == 'e' && - name[4] == 'n') - { /* given */ - return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_given : 0); - } - - goto unknown; - - case 'i': - switch (name[1]) - { - case 'n': - if (name[2] == 'd' && - name[3] == 'e' && - name[4] == 'x') - { /* index */ - return -KEY_index; - } - - goto unknown; - - case 'o': - if (name[2] == 'c' && - name[3] == 't' && - name[4] == 'l') - { /* ioctl */ - return -KEY_ioctl; - } - - goto unknown; - - default: - goto unknown; - } - - case 'l': - switch (name[1]) - { - case 'o': - if (name[2] == 'c' && - name[3] == 'a' && - name[4] == 'l') - { /* local */ - return KEY_local; - } - - goto unknown; - - case 's': - if (name[2] == 't' && - name[3] == 'a' && - name[4] == 't') - { /* lstat */ - return -KEY_lstat; - } - - goto unknown; - - default: - goto unknown; - } - - case 'm': - if (name[1] == 'k' && - name[2] == 'd' && - name[3] == 'i' && - name[4] == 'r') - { /* mkdir */ - return -KEY_mkdir; - } - - goto unknown; - - case 'p': - if (name[1] == 'r' && - name[2] == 'i' && - name[3] == 'n' && - name[4] == 't') - { /* print */ - return KEY_print; - } - - goto unknown; - - case 'r': - switch (name[1]) - { - case 'e': - if (name[2] == 's' && - name[3] == 'e' && - name[4] == 't') - { /* reset */ - return -KEY_reset; - } - - goto unknown; - - case 'm': - if (name[2] == 'd' && - name[3] == 'i' && - name[4] == 'r') - { /* rmdir */ - return -KEY_rmdir; - } - - goto unknown; - - default: - goto unknown; - } - - case 's': - switch (name[1]) - { - case 'e': - if (name[2] == 'm' && - name[3] == 'o' && - name[4] == 'p') - { /* semop */ - return -KEY_semop; - } - - goto unknown; - - case 'h': - if (name[2] == 'i' && - name[3] == 'f' && - name[4] == 't') - { /* shift */ - return -KEY_shift; - } - - goto unknown; - - case 'l': - if (name[2] == 'e' && - name[3] == 'e' && - name[4] == 'p') - { /* sleep */ - return -KEY_sleep; - } - - goto unknown; - - case 'p': - if (name[2] == 'l' && - name[3] == 'i' && - name[4] == 't') - { /* split */ - return KEY_split; - } - - goto unknown; - - case 'r': - if (name[2] == 'a' && - name[3] == 'n' && - name[4] == 'd') - { /* srand */ - return -KEY_srand; - } - - goto unknown; - - case 't': - switch (name[2]) - { - case 'a': - if (name[3] == 't' && - name[4] == 'e') - { /* state */ - return (all_keywords || FEATURE_IS_ENABLED("state") ? KEY_state : 0); - } - - goto unknown; - - case 'u': - if (name[3] == 'd' && - name[4] == 'y') - { /* study */ - return KEY_study; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 't': - if (name[1] == 'i' && - name[2] == 'm' && - name[3] == 'e' && - name[4] == 's') - { /* times */ - return -KEY_times; - } - - goto unknown; - - case 'u': - switch (name[1]) - { - case 'm': - if (name[2] == 'a' && - name[3] == 's' && - name[4] == 'k') - { /* umask */ - return -KEY_umask; - } - - goto unknown; - - case 'n': - switch (name[2]) - { - case 'd': - if (name[3] == 'e' && - name[4] == 'f') - { /* undef */ - return KEY_undef; - } - - goto unknown; - - case 't': - if (name[3] == 'i') - { - switch (name[4]) - { - case 'e': - { /* untie */ - return -KEY_untie; - } - - case 'l': - { /* until */ - return KEY_until; - } - - default: - goto unknown; - } - } - - goto unknown; - - default: - goto unknown; - } - - case 't': - if (name[2] == 'i' && - name[3] == 'm' && - name[4] == 'e') - { /* utime */ - return -KEY_utime; - } - - goto unknown; - - default: - goto unknown; - } - - case 'w': - switch (name[1]) - { - case 'h': - if (name[2] == 'i' && - name[3] == 'l' && - name[4] == 'e') - { /* while */ - return KEY_while; - } - - goto unknown; - - case 'r': - if (name[2] == 'i' && - name[3] == 't' && - name[4] == 'e') - { /* write */ - return -KEY_write; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 6: /* 33 tokens of length 6 */ - switch (name[0]) - { - case 'a': - if (name[1] == 'c' && - name[2] == 'c' && - name[3] == 'e' && - name[4] == 'p' && - name[5] == 't') - { /* accept */ - return -KEY_accept; - } - - goto unknown; - - case 'c': - switch (name[1]) - { - case 'a': - if (name[2] == 'l' && - name[3] == 'l' && - name[4] == 'e' && - name[5] == 'r') - { /* caller */ - return -KEY_caller; - } - - goto unknown; - - case 'h': - if (name[2] == 'r' && - name[3] == 'o' && - name[4] == 'o' && - name[5] == 't') - { /* chroot */ - return -KEY_chroot; - } - - goto unknown; - - default: - goto unknown; - } - - case 'd': - if (name[1] == 'e' && - name[2] == 'l' && - name[3] == 'e' && - name[4] == 't' && - name[5] == 'e') - { /* delete */ - return KEY_delete; - } - - goto unknown; - - case 'e': - switch (name[1]) - { - case 'l': - if (name[2] == 's' && - name[3] == 'e' && - name[4] == 'i' && - name[5] == 'f') - { /* elseif */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif"); - } - - goto unknown; - - case 'x': - if (name[2] == 'i' && - name[3] == 's' && - name[4] == 't' && - name[5] == 's') - { /* exists */ - return KEY_exists; - } - - goto unknown; - - default: - goto unknown; - } - - case 'f': - switch (name[1]) - { - case 'i': - if (name[2] == 'l' && - name[3] == 'e' && - name[4] == 'n' && - name[5] == 'o') - { /* fileno */ - return -KEY_fileno; - } - - goto unknown; - - case 'o': - if (name[2] == 'r' && - name[3] == 'm' && - name[4] == 'a' && - name[5] == 't') - { /* format */ - return KEY_format; - } - - goto unknown; - - default: - goto unknown; - } - - case 'g': - if (name[1] == 'm' && - name[2] == 't' && - name[3] == 'i' && - name[4] == 'm' && - name[5] == 'e') - { /* gmtime */ - return -KEY_gmtime; - } - - goto unknown; - - case 'l': - switch (name[1]) - { - case 'e': - if (name[2] == 'n' && - name[3] == 'g' && - name[4] == 't' && - name[5] == 'h') - { /* length */ - return -KEY_length; - } - - goto unknown; - - case 'i': - if (name[2] == 's' && - name[3] == 't' && - name[4] == 'e' && - name[5] == 'n') - { /* listen */ - return -KEY_listen; - } - - goto unknown; - - default: - goto unknown; - } - - case 'm': - if (name[1] == 's' && - name[2] == 'g') - { - switch (name[3]) - { - case 'c': - if (name[4] == 't' && - name[5] == 'l') - { /* msgctl */ - return -KEY_msgctl; - } - - goto unknown; - - case 'g': - if (name[4] == 'e' && - name[5] == 't') - { /* msgget */ - return -KEY_msgget; - } - - goto unknown; - - case 'r': - if (name[4] == 'c' && - name[5] == 'v') - { /* msgrcv */ - return -KEY_msgrcv; - } - - goto unknown; - - case 's': - if (name[4] == 'n' && - name[5] == 'd') - { /* msgsnd */ - return -KEY_msgsnd; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'p': - if (name[1] == 'r' && - name[2] == 'i' && - name[3] == 'n' && - name[4] == 't' && - name[5] == 'f') - { /* printf */ - return KEY_printf; - } - - goto unknown; - - case 'r': - switch (name[1]) - { - case 'e': - switch (name[2]) - { - case 'n': - if (name[3] == 'a' && - name[4] == 'm' && - name[5] == 'e') - { /* rename */ - return -KEY_rename; - } - - goto unknown; - - case 't': - if (name[3] == 'u' && - name[4] == 'r' && - name[5] == 'n') - { /* return */ - return KEY_return; - } - - goto unknown; - - default: - goto unknown; - } - - case 'i': - if (name[2] == 'n' && - name[3] == 'd' && - name[4] == 'e' && - name[5] == 'x') - { /* rindex */ - return -KEY_rindex; - } - - goto unknown; - - default: - goto unknown; - } - - case 's': - switch (name[1]) - { - case 'c': - if (name[2] == 'a' && - name[3] == 'l' && - name[4] == 'a' && - name[5] == 'r') - { /* scalar */ - return KEY_scalar; - } - - goto unknown; - - case 'e': - switch (name[2]) - { - case 'l': - if (name[3] == 'e' && - name[4] == 'c' && - name[5] == 't') - { /* select */ - return -KEY_select; - } - - goto unknown; - - case 'm': - switch (name[3]) - { - case 'c': - if (name[4] == 't' && - name[5] == 'l') - { /* semctl */ - return -KEY_semctl; - } - - goto unknown; - - case 'g': - if (name[4] == 'e' && - name[5] == 't') - { /* semget */ - return -KEY_semget; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 'h': - if (name[2] == 'm') - { - switch (name[3]) - { - case 'c': - if (name[4] == 't' && - name[5] == 'l') - { /* shmctl */ - return -KEY_shmctl; - } - - goto unknown; - - case 'g': - if (name[4] == 'e' && - name[5] == 't') - { /* shmget */ - return -KEY_shmget; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'o': - if (name[2] == 'c' && - name[3] == 'k' && - name[4] == 'e' && - name[5] == 't') - { /* socket */ - return -KEY_socket; - } - - goto unknown; - - case 'p': - if (name[2] == 'l' && - name[3] == 'i' && - name[4] == 'c' && - name[5] == 'e') - { /* splice */ - return -KEY_splice; - } - - goto unknown; - - case 'u': - if (name[2] == 'b' && - name[3] == 's' && - name[4] == 't' && - name[5] == 'r') - { /* substr */ - return -KEY_substr; - } - - goto unknown; - - case 'y': - if (name[2] == 's' && - name[3] == 't' && - name[4] == 'e' && - name[5] == 'm') - { /* system */ - return -KEY_system; - } - - goto unknown; - - default: - goto unknown; - } - - case 'u': - if (name[1] == 'n') - { - switch (name[2]) - { - case 'l': - switch (name[3]) - { - case 'e': - if (name[4] == 's' && - name[5] == 's') - { /* unless */ - return KEY_unless; - } - - goto unknown; - - case 'i': - if (name[4] == 'n' && - name[5] == 'k') - { /* unlink */ - return -KEY_unlink; - } - - goto unknown; - - default: - goto unknown; - } - - case 'p': - if (name[3] == 'a' && - name[4] == 'c' && - name[5] == 'k') - { /* unpack */ - return -KEY_unpack; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'v': - if (name[1] == 'a' && - name[2] == 'l' && - name[3] == 'u' && - name[4] == 'e' && - name[5] == 's') - { /* values */ - return -KEY_values; - } - - goto unknown; - - default: - goto unknown; - } - - case 7: /* 29 tokens of length 7 */ - switch (name[0]) - { - case 'D': - if (name[1] == 'E' && - name[2] == 'S' && - name[3] == 'T' && - name[4] == 'R' && - name[5] == 'O' && - name[6] == 'Y') - { /* DESTROY */ - return KEY_DESTROY; - } - - goto unknown; - - case '_': - if (name[1] == '_' && - name[2] == 'E' && - name[3] == 'N' && - name[4] == 'D' && - name[5] == '_' && - name[6] == '_') - { /* __END__ */ - return KEY___END__; - } - - goto unknown; - - case 'b': - if (name[1] == 'i' && - name[2] == 'n' && - name[3] == 'm' && - name[4] == 'o' && - name[5] == 'd' && - name[6] == 'e') - { /* binmode */ - return -KEY_binmode; - } - - goto unknown; - - case 'c': - if (name[1] == 'o' && - name[2] == 'n' && - name[3] == 'n' && - name[4] == 'e' && - name[5] == 'c' && - name[6] == 't') - { /* connect */ - return -KEY_connect; - } - - goto unknown; - - case 'd': - switch (name[1]) - { - case 'b': - if (name[2] == 'm' && - name[3] == 'o' && - name[4] == 'p' && - name[5] == 'e' && - name[6] == 'n') - { /* dbmopen */ - return -KEY_dbmopen; - } - - goto unknown; - - case 'e': - if (name[2] == 'f') - { - switch (name[3]) - { - case 'a': - if (name[4] == 'u' && - name[5] == 'l' && - name[6] == 't') - { /* default */ - return (all_keywords || FEATURE_IS_ENABLED("switch") ? KEY_default : 0); - } - - goto unknown; - - case 'i': - if (name[4] == 'n' && - name[5] == 'e' && - name[6] == 'd') - { /* defined */ - return KEY_defined; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - default: - goto unknown; - } - - case 'f': - if (name[1] == 'o' && - name[2] == 'r' && - name[3] == 'e' && - name[4] == 'a' && - name[5] == 'c' && - name[6] == 'h') - { /* foreach */ - return KEY_foreach; - } - - goto unknown; - - case 'g': - if (name[1] == 'e' && - name[2] == 't' && - name[3] == 'p') - { - switch (name[4]) - { - case 'g': - if (name[5] == 'r' && - name[6] == 'p') - { /* getpgrp */ - return -KEY_getpgrp; - } - - goto unknown; - - case 'p': - if (name[5] == 'i' && - name[6] == 'd') - { /* getppid */ - return -KEY_getppid; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'l': - if (name[1] == 'c' && - name[2] == 'f' && - name[3] == 'i' && - name[4] == 'r' && - name[5] == 's' && - name[6] == 't') - { /* lcfirst */ - return -KEY_lcfirst; - } - - goto unknown; - - case 'o': - if (name[1] == 'p' && - name[2] == 'e' && - name[3] == 'n' && - name[4] == 'd' && - name[5] == 'i' && - name[6] == 'r') - { /* opendir */ - return -KEY_opendir; - } - - goto unknown; - - case 'p': - if (name[1] == 'a' && - name[2] == 'c' && - name[3] == 'k' && - name[4] == 'a' && - name[5] == 'g' && - name[6] == 'e') - { /* package */ - return KEY_package; - } - - goto unknown; - - case 'r': - if (name[1] == 'e') - { - switch (name[2]) - { - case 'a': - if (name[3] == 'd' && - name[4] == 'd' && - name[5] == 'i' && - name[6] == 'r') - { /* readdir */ - return -KEY_readdir; - } - - goto unknown; - - case 'q': - if (name[3] == 'u' && - name[4] == 'i' && - name[5] == 'r' && - name[6] == 'e') - { /* require */ - return KEY_require; - } - - goto unknown; - - case 'v': - if (name[3] == 'e' && - name[4] == 'r' && - name[5] == 's' && - name[6] == 'e') - { /* reverse */ - return -KEY_reverse; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 's': - switch (name[1]) - { - case 'e': - switch (name[2]) - { - case 'e': - if (name[3] == 'k' && - name[4] == 'd' && - name[5] == 'i' && - name[6] == 'r') - { /* seekdir */ - return -KEY_seekdir; - } - - goto unknown; - - case 't': - if (name[3] == 'p' && - name[4] == 'g' && - name[5] == 'r' && - name[6] == 'p') - { /* setpgrp */ - return -KEY_setpgrp; - } - - goto unknown; - - default: - goto unknown; - } - - case 'h': - if (name[2] == 'm' && - name[3] == 'r' && - name[4] == 'e' && - name[5] == 'a' && - name[6] == 'd') - { /* shmread */ - return -KEY_shmread; - } - - goto unknown; - - case 'p': - if (name[2] == 'r' && - name[3] == 'i' && - name[4] == 'n' && - name[5] == 't' && - name[6] == 'f') - { /* sprintf */ - return -KEY_sprintf; - } - - goto unknown; - - case 'y': - switch (name[2]) - { - case 'm': - if (name[3] == 'l' && - name[4] == 'i' && - name[5] == 'n' && - name[6] == 'k') - { /* symlink */ - return -KEY_symlink; - } - - goto unknown; - - case 's': - switch (name[3]) - { - case 'c': - if (name[4] == 'a' && - name[5] == 'l' && - name[6] == 'l') - { /* syscall */ - return -KEY_syscall; - } - - goto unknown; - - case 'o': - if (name[4] == 'p' && - name[5] == 'e' && - name[6] == 'n') - { /* sysopen */ - return -KEY_sysopen; - } - - goto unknown; - - case 'r': - if (name[4] == 'e' && - name[5] == 'a' && - name[6] == 'd') - { /* sysread */ - return -KEY_sysread; - } - - goto unknown; - - case 's': - if (name[4] == 'e' && - name[5] == 'e' && - name[6] == 'k') - { /* sysseek */ - return -KEY_sysseek; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 't': - if (name[1] == 'e' && - name[2] == 'l' && - name[3] == 'l' && - name[4] == 'd' && - name[5] == 'i' && - name[6] == 'r') - { /* telldir */ - return -KEY_telldir; - } - - goto unknown; - - case 'u': - switch (name[1]) - { - case 'c': - if (name[2] == 'f' && - name[3] == 'i' && - name[4] == 'r' && - name[5] == 's' && - name[6] == 't') - { /* ucfirst */ - return -KEY_ucfirst; - } - - goto unknown; - - case 'n': - if (name[2] == 's' && - name[3] == 'h' && - name[4] == 'i' && - name[5] == 'f' && - name[6] == 't') - { /* unshift */ - return -KEY_unshift; - } - - goto unknown; - - default: - goto unknown; - } - - case 'w': - if (name[1] == 'a' && - name[2] == 'i' && - name[3] == 't' && - name[4] == 'p' && - name[5] == 'i' && - name[6] == 'd') - { /* waitpid */ - return -KEY_waitpid; - } - - goto unknown; - - default: - goto unknown; - } - - case 8: /* 26 tokens of length 8 */ - switch (name[0]) - { - case 'A': - if (name[1] == 'U' && - name[2] == 'T' && - name[3] == 'O' && - name[4] == 'L' && - name[5] == 'O' && - name[6] == 'A' && - name[7] == 'D') - { /* AUTOLOAD */ - return KEY_AUTOLOAD; - } - - goto unknown; - - case '_': - if (name[1] == '_') - { - switch (name[2]) - { - case 'D': - if (name[3] == 'A' && - name[4] == 'T' && - name[5] == 'A' && - name[6] == '_' && - name[7] == '_') - { /* __DATA__ */ - return KEY___DATA__; - } - - goto unknown; - - case 'F': - if (name[3] == 'I' && - name[4] == 'L' && - name[5] == 'E' && - name[6] == '_' && - name[7] == '_') - { /* __FILE__ */ - return -KEY___FILE__; - } - - goto unknown; - - case 'L': - if (name[3] == 'I' && - name[4] == 'N' && - name[5] == 'E' && - name[6] == '_' && - name[7] == '_') - { /* __LINE__ */ - return -KEY___LINE__; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'c': - switch (name[1]) - { - case 'l': - if (name[2] == 'o' && - name[3] == 's' && - name[4] == 'e' && - name[5] == 'd' && - name[6] == 'i' && - name[7] == 'r') - { /* closedir */ - return -KEY_closedir; - } - - goto unknown; - - case 'o': - if (name[2] == 'n' && - name[3] == 't' && - name[4] == 'i' && - name[5] == 'n' && - name[6] == 'u' && - name[7] == 'e') - { /* continue */ - return -KEY_continue; - } - - goto unknown; - - default: - goto unknown; - } - - case 'd': - if (name[1] == 'b' && - name[2] == 'm' && - name[3] == 'c' && - name[4] == 'l' && - name[5] == 'o' && - name[6] == 's' && - name[7] == 'e') - { /* dbmclose */ - return -KEY_dbmclose; - } - - goto unknown; - - case 'e': - if (name[1] == 'n' && - name[2] == 'd') - { - switch (name[3]) - { - case 'g': - if (name[4] == 'r' && - name[5] == 'e' && - name[6] == 'n' && - name[7] == 't') - { /* endgrent */ - return -KEY_endgrent; - } - - goto unknown; - - case 'p': - if (name[4] == 'w' && - name[5] == 'e' && - name[6] == 'n' && - name[7] == 't') - { /* endpwent */ - return -KEY_endpwent; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'f': - if (name[1] == 'o' && - name[2] == 'r' && - name[3] == 'm' && - name[4] == 'l' && - name[5] == 'i' && - name[6] == 'n' && - name[7] == 'e') - { /* formline */ - return -KEY_formline; - } - - goto unknown; - - case 'g': - if (name[1] == 'e' && - name[2] == 't') - { - switch (name[3]) - { - case 'g': - if (name[4] == 'r') - { - switch (name[5]) - { - case 'e': - if (name[6] == 'n' && - name[7] == 't') - { /* getgrent */ - return -KEY_getgrent; - } - - goto unknown; - - case 'g': - if (name[6] == 'i' && - name[7] == 'd') - { /* getgrgid */ - return -KEY_getgrgid; - } - - goto unknown; - - case 'n': - if (name[6] == 'a' && - name[7] == 'm') - { /* getgrnam */ - return -KEY_getgrnam; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'l': - if (name[4] == 'o' && - name[5] == 'g' && - name[6] == 'i' && - name[7] == 'n') - { /* getlogin */ - return -KEY_getlogin; - } - - goto unknown; - - case 'p': - if (name[4] == 'w') - { - switch (name[5]) - { - case 'e': - if (name[6] == 'n' && - name[7] == 't') - { /* getpwent */ - return -KEY_getpwent; - } - - goto unknown; - - case 'n': - if (name[6] == 'a' && - name[7] == 'm') - { /* getpwnam */ - return -KEY_getpwnam; - } - - goto unknown; - - case 'u': - if (name[6] == 'i' && - name[7] == 'd') - { /* getpwuid */ - return -KEY_getpwuid; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'r': - if (name[1] == 'e' && - name[2] == 'a' && - name[3] == 'd') - { - switch (name[4]) - { - case 'l': - if (name[5] == 'i' && - name[6] == 'n') - { - switch (name[7]) - { - case 'e': - { /* readline */ - return -KEY_readline; - } - - case 'k': - { /* readlink */ - return -KEY_readlink; - } - - default: - goto unknown; - } - } - - goto unknown; - - case 'p': - if (name[5] == 'i' && - name[6] == 'p' && - name[7] == 'e') - { /* readpipe */ - return -KEY_readpipe; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 's': - switch (name[1]) - { - case 'e': - if (name[2] == 't') - { - switch (name[3]) - { - case 'g': - if (name[4] == 'r' && - name[5] == 'e' && - name[6] == 'n' && - name[7] == 't') - { /* setgrent */ - return -KEY_setgrent; - } - - goto unknown; - - case 'p': - if (name[4] == 'w' && - name[5] == 'e' && - name[6] == 'n' && - name[7] == 't') - { /* setpwent */ - return -KEY_setpwent; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'h': - switch (name[2]) - { - case 'm': - if (name[3] == 'w' && - name[4] == 'r' && - name[5] == 'i' && - name[6] == 't' && - name[7] == 'e') - { /* shmwrite */ - return -KEY_shmwrite; - } - - goto unknown; - - case 'u': - if (name[3] == 't' && - name[4] == 'd' && - name[5] == 'o' && - name[6] == 'w' && - name[7] == 'n') - { /* shutdown */ - return -KEY_shutdown; - } - - goto unknown; - - default: - goto unknown; - } - - case 'y': - if (name[2] == 's' && - name[3] == 'w' && - name[4] == 'r' && - name[5] == 'i' && - name[6] == 't' && - name[7] == 'e') - { /* syswrite */ - return -KEY_syswrite; - } - - goto unknown; - - default: - goto unknown; - } - - case 't': - if (name[1] == 'r' && - name[2] == 'u' && - name[3] == 'n' && - name[4] == 'c' && - name[5] == 'a' && - name[6] == 't' && - name[7] == 'e') - { /* truncate */ - return -KEY_truncate; - } - - goto unknown; - - default: - goto unknown; - } - - case 9: /* 9 tokens of length 9 */ - switch (name[0]) - { - case 'U': - if (name[1] == 'N' && - name[2] == 'I' && - name[3] == 'T' && - name[4] == 'C' && - name[5] == 'H' && - name[6] == 'E' && - name[7] == 'C' && - name[8] == 'K') - { /* UNITCHECK */ - return KEY_UNITCHECK; - } - - goto unknown; - - case 'e': - if (name[1] == 'n' && - name[2] == 'd' && - name[3] == 'n' && - name[4] == 'e' && - name[5] == 't' && - name[6] == 'e' && - name[7] == 'n' && - name[8] == 't') - { /* endnetent */ - return -KEY_endnetent; - } - - goto unknown; - - case 'g': - if (name[1] == 'e' && - name[2] == 't' && - name[3] == 'n' && - name[4] == 'e' && - name[5] == 't' && - name[6] == 'e' && - name[7] == 'n' && - name[8] == 't') - { /* getnetent */ - return -KEY_getnetent; - } - - goto unknown; - - case 'l': - if (name[1] == 'o' && - name[2] == 'c' && - name[3] == 'a' && - name[4] == 'l' && - name[5] == 't' && - name[6] == 'i' && - name[7] == 'm' && - name[8] == 'e') - { /* localtime */ - return -KEY_localtime; - } - - goto unknown; - - case 'p': - if (name[1] == 'r' && - name[2] == 'o' && - name[3] == 't' && - name[4] == 'o' && - name[5] == 't' && - name[6] == 'y' && - name[7] == 'p' && - name[8] == 'e') - { /* prototype */ - return KEY_prototype; - } - - goto unknown; - - case 'q': - if (name[1] == 'u' && - name[2] == 'o' && - name[3] == 't' && - name[4] == 'e' && - name[5] == 'm' && - name[6] == 'e' && - name[7] == 't' && - name[8] == 'a') - { /* quotemeta */ - return -KEY_quotemeta; - } - - goto unknown; - - case 'r': - if (name[1] == 'e' && - name[2] == 'w' && - name[3] == 'i' && - name[4] == 'n' && - name[5] == 'd' && - name[6] == 'd' && - name[7] == 'i' && - name[8] == 'r') - { /* rewinddir */ - return -KEY_rewinddir; - } - - goto unknown; - - case 's': - if (name[1] == 'e' && - name[2] == 't' && - name[3] == 'n' && - name[4] == 'e' && - name[5] == 't' && - name[6] == 'e' && - name[7] == 'n' && - name[8] == 't') - { /* setnetent */ - return -KEY_setnetent; - } - - goto unknown; - - case 'w': - if (name[1] == 'a' && - name[2] == 'n' && - name[3] == 't' && - name[4] == 'a' && - name[5] == 'r' && - name[6] == 'r' && - name[7] == 'a' && - name[8] == 'y') - { /* wantarray */ - return -KEY_wantarray; - } - - goto unknown; - - default: - goto unknown; - } - - case 10: /* 9 tokens of length 10 */ - switch (name[0]) - { - case 'e': - if (name[1] == 'n' && - name[2] == 'd') - { - switch (name[3]) - { - case 'h': - if (name[4] == 'o' && - name[5] == 's' && - name[6] == 't' && - name[7] == 'e' && - name[8] == 'n' && - name[9] == 't') - { /* endhostent */ - return -KEY_endhostent; - } - - goto unknown; - - case 's': - if (name[4] == 'e' && - name[5] == 'r' && - name[6] == 'v' && - name[7] == 'e' && - name[8] == 'n' && - name[9] == 't') - { /* endservent */ - return -KEY_endservent; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 'g': - if (name[1] == 'e' && - name[2] == 't') - { - switch (name[3]) - { - case 'h': - if (name[4] == 'o' && - name[5] == 's' && - name[6] == 't' && - name[7] == 'e' && - name[8] == 'n' && - name[9] == 't') - { /* gethostent */ - return -KEY_gethostent; - } - - goto unknown; - - case 's': - switch (name[4]) - { - case 'e': - if (name[5] == 'r' && - name[6] == 'v' && - name[7] == 'e' && - name[8] == 'n' && - name[9] == 't') - { /* getservent */ - return -KEY_getservent; - } - - goto unknown; - - case 'o': - if (name[5] == 'c' && - name[6] == 'k' && - name[7] == 'o' && - name[8] == 'p' && - name[9] == 't') - { /* getsockopt */ - return -KEY_getsockopt; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - } - - goto unknown; - - case 's': - switch (name[1]) - { - case 'e': - if (name[2] == 't') - { - switch (name[3]) - { - case 'h': - if (name[4] == 'o' && - name[5] == 's' && - name[6] == 't' && - name[7] == 'e' && - name[8] == 'n' && - name[9] == 't') - { /* sethostent */ - return -KEY_sethostent; - } - - goto unknown; - - case 's': - switch (name[4]) - { - case 'e': - if (name[5] == 'r' && - name[6] == 'v' && - name[7] == 'e' && - name[8] == 'n' && - name[9] == 't') - { /* setservent */ - return -KEY_setservent; - } - - goto unknown; - - case 'o': - if (name[5] == 'c' && - name[6] == 'k' && - name[7] == 'o' && - name[8] == 'p' && - name[9] == 't') - { /* setsockopt */ - return -KEY_setsockopt; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - } - - goto unknown; - - case 'o': - if (name[2] == 'c' && - name[3] == 'k' && - name[4] == 'e' && - name[5] == 't' && - name[6] == 'p' && - name[7] == 'a' && - name[8] == 'i' && - name[9] == 'r') - { /* socketpair */ - return -KEY_socketpair; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 11: /* 8 tokens of length 11 */ - switch (name[0]) - { - case '_': - if (name[1] == '_' && - name[2] == 'P' && - name[3] == 'A' && - name[4] == 'C' && - name[5] == 'K' && - name[6] == 'A' && - name[7] == 'G' && - name[8] == 'E' && - name[9] == '_' && - name[10] == '_') - { /* __PACKAGE__ */ - return -KEY___PACKAGE__; - } - - goto unknown; - - case 'e': - if (name[1] == 'n' && - name[2] == 'd' && - name[3] == 'p' && - name[4] == 'r' && - name[5] == 'o' && - name[6] == 't' && - name[7] == 'o' && - name[8] == 'e' && - name[9] == 'n' && - name[10] == 't') - { /* endprotoent */ - return -KEY_endprotoent; - } - - goto unknown; - - case 'g': - if (name[1] == 'e' && - name[2] == 't') - { - switch (name[3]) - { - case 'p': - switch (name[4]) - { - case 'e': - if (name[5] == 'e' && - name[6] == 'r' && - name[7] == 'n' && - name[8] == 'a' && - name[9] == 'm' && - name[10] == 'e') - { /* getpeername */ - return -KEY_getpeername; - } - - goto unknown; - - case 'r': - switch (name[5]) - { - case 'i': - if (name[6] == 'o' && - name[7] == 'r' && - name[8] == 'i' && - name[9] == 't' && - name[10] == 'y') - { /* getpriority */ - return -KEY_getpriority; - } - - goto unknown; - - case 'o': - if (name[6] == 't' && - name[7] == 'o' && - name[8] == 'e' && - name[9] == 'n' && - name[10] == 't') - { /* getprotoent */ - return -KEY_getprotoent; - } - - goto unknown; - - default: - goto unknown; - } - - default: - goto unknown; - } - - case 's': - if (name[4] == 'o' && - name[5] == 'c' && - name[6] == 'k' && - name[7] == 'n' && - name[8] == 'a' && - name[9] == 'm' && - name[10] == 'e') - { /* getsockname */ - return -KEY_getsockname; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 's': - if (name[1] == 'e' && - name[2] == 't' && - name[3] == 'p' && - name[4] == 'r') - { - switch (name[5]) - { - case 'i': - if (name[6] == 'o' && - name[7] == 'r' && - name[8] == 'i' && - name[9] == 't' && - name[10] == 'y') - { /* setpriority */ - return -KEY_setpriority; - } - - goto unknown; - - case 'o': - if (name[6] == 't' && - name[7] == 'o' && - name[8] == 'e' && - name[9] == 'n' && - name[10] == 't') - { /* setprotoent */ - return -KEY_setprotoent; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - default: - goto unknown; - } - - case 12: /* 2 tokens of length 12 */ - if (name[0] == 'g' && - name[1] == 'e' && - name[2] == 't' && - name[3] == 'n' && - name[4] == 'e' && - name[5] == 't' && - name[6] == 'b' && - name[7] == 'y') - { - switch (name[8]) - { - case 'a': - if (name[9] == 'd' && - name[10] == 'd' && - name[11] == 'r') - { /* getnetbyaddr */ - return -KEY_getnetbyaddr; - } - - goto unknown; - - case 'n': - if (name[9] == 'a' && - name[10] == 'm' && - name[11] == 'e') - { /* getnetbyname */ - return -KEY_getnetbyname; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 13: /* 4 tokens of length 13 */ - if (name[0] == 'g' && - name[1] == 'e' && - name[2] == 't') - { - switch (name[3]) - { - case 'h': - if (name[4] == 'o' && - name[5] == 's' && - name[6] == 't' && - name[7] == 'b' && - name[8] == 'y') - { - switch (name[9]) - { - case 'a': - if (name[10] == 'd' && - name[11] == 'd' && - name[12] == 'r') - { /* gethostbyaddr */ - return -KEY_gethostbyaddr; - } - - goto unknown; - - case 'n': - if (name[10] == 'a' && - name[11] == 'm' && - name[12] == 'e') - { /* gethostbyname */ - return -KEY_gethostbyname; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 's': - if (name[4] == 'e' && - name[5] == 'r' && - name[6] == 'v' && - name[7] == 'b' && - name[8] == 'y') - { - switch (name[9]) - { - case 'n': - if (name[10] == 'a' && - name[11] == 'm' && - name[12] == 'e') - { /* getservbyname */ - return -KEY_getservbyname; - } - - goto unknown; - - case 'p': - if (name[10] == 'o' && - name[11] == 'r' && - name[12] == 't') - { /* getservbyport */ - return -KEY_getservbyport; - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - default: - goto unknown; - } - } - - goto unknown; - - case 14: /* 1 tokens of length 14 */ - if (name[0] == 'g' && - name[1] == 'e' && - name[2] == 't' && - name[3] == 'p' && - name[4] == 'r' && - name[5] == 'o' && - name[6] == 't' && - name[7] == 'o' && - name[8] == 'b' && - name[9] == 'y' && - name[10] == 'n' && - name[11] == 'a' && - name[12] == 'm' && - name[13] == 'e') - { /* getprotobyname */ - return -KEY_getprotobyname; - } - - goto unknown; - - case 16: /* 1 tokens of length 16 */ - if (name[0] == 'g' && - name[1] == 'e' && - name[2] == 't' && - name[3] == 'p' && - name[4] == 'r' && - name[5] == 'o' && - name[6] == 't' && - name[7] == 'o' && - name[8] == 'b' && - name[9] == 'y' && - name[10] == 'n' && - name[11] == 'u' && - name[12] == 'm' && - name[13] == 'b' && - name[14] == 'e' && - name[15] == 'r') - { /* getprotobynumber */ - return -KEY_getprotobynumber; - } - - goto unknown; - - default: - goto unknown; - } - -unknown: - return 0; -} - STATIC void S_checkcomma(pTHX_ const char *s, const char *name, const char *what) { @@ -12099,6 +8742,7 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL const char * const brack = (const char *) ((*s == '[') ? "[...]" : "{...}"); + /* diag_listed_as: Ambiguous use of %c{%s[...]} resolved to %c%s[...] */ Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS), "Ambiguous use of %c{%s%s} resolved to %c%s%s", funny, dest, brack, funny, dest, brack); @@ -12151,17 +8795,138 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL return s; } -static U32 -S_pmflag(U32 pmfl, const char ch) { - switch (ch) { - CASE_STD_PMMOD_FLAGS_PARSE_SET(&pmfl); - case GLOBAL_PAT_MOD: pmfl |= PMf_GLOBAL; break; - case CONTINUE_PAT_MOD: pmfl |= PMf_CONTINUE; break; - case ONCE_PAT_MOD: pmfl |= PMf_KEEP; break; - case KEEPCOPY_PAT_MOD: pmfl |= PMf_KEEPCOPY; break; - case NONDESTRUCT_PAT_MOD: pmfl |= PMf_NONDESTRUCT; break; - } - return pmfl; +static bool +S_pmflag(pTHX_ const char* const valid_flags, U32 * pmfl, char** s, char* charset) { + + /* Adds, subtracts to/from 'pmfl' based on regex modifier flags found in + * the parse starting at 's', based on the subset that are valid in this + * context input to this routine in 'valid_flags'. Advances s. Returns + * TRUE if the input was a valid flag, so the next char may be as well; + * otherwise FALSE. 'charset' should point to a NUL upon first call on the + * current regex. This routine will set it to any charset modifier found. + * The caller shouldn't change it. This way, another charset modifier + * encountered in the parse can be detected as an error, as we have decided + * allow only one */ + + const char c = **s; + + if (! strchr(valid_flags, c)) { + if (isALNUM(c)) { + goto deprecate; + } + return FALSE; + } + + switch (c) { + + CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl); + case GLOBAL_PAT_MOD: *pmfl |= PMf_GLOBAL; break; + case CONTINUE_PAT_MOD: *pmfl |= PMf_CONTINUE; break; + case ONCE_PAT_MOD: *pmfl |= PMf_KEEP; break; + case KEEPCOPY_PAT_MOD: *pmfl |= RXf_PMf_KEEPCOPY; break; + case NONDESTRUCT_PAT_MOD: *pmfl |= PMf_NONDESTRUCT; break; + case LOCALE_PAT_MOD: + + /* In 5.14, qr//lt is legal but deprecated; the 't' means they + * can't be regex modifiers. + * In 5.14, s///le is legal and ambiguous. Try to disambiguate as + * much as easily done. s///lei, for example, has to mean regex + * modifiers if it's not an error (as does any word character + * following the 'e'). Otherwise, we resolve to the backwards- + * compatible, but less likely 's/// le ...', i.e. as meaning + * less-than-or-equal. The reason it's not likely is that s// + * returns a number for code in the field (/r returns a string, but + * that wasn't added until the 5.13 series), and so '<=' should be + * used for comparing, not 'le'. */ + if (*((*s) + 1) == 't') { + goto deprecate; + } + else if (*((*s) + 1) == 'e' && ! isALNUM(*((*s) + 2))) { + + /* 'e' is valid only for substitutes, s///e. If it is not + * valid in the current context, then 'm//le' must mean the + * comparison operator, so use the regular deprecation message. + */ + if (! strchr(valid_flags, 'e')) { + goto deprecate; + } + Perl_ck_warner_d(aTHX_ packWARN(WARN_AMBIGUOUS), + "Ambiguous use of 's//le...' resolved as 's// le...'; Rewrite as 's//el' if you meant 'use locale rules and evaluate rhs as an expression'. In Perl 5.16, it will be resolved the other way"); + return FALSE; + } + if (*charset) { + goto multiple_charsets; + } + set_regex_charset(pmfl, REGEX_LOCALE_CHARSET); + *charset = c; + break; + case UNICODE_PAT_MOD: + /* In 5.14, qr//unless and qr//until are legal but deprecated; the + * 'n' means they can't be regex modifiers */ + if (*((*s) + 1) == 'n') { + goto deprecate; + } + if (*charset) { + goto multiple_charsets; + } + set_regex_charset(pmfl, REGEX_UNICODE_CHARSET); + *charset = c; + break; + case ASCII_RESTRICT_PAT_MOD: + /* In 5.14, qr//and is legal but deprecated; the 'n' means they + * can't be regex modifiers */ + if (*((*s) + 1) == 'n') { + goto deprecate; + } + + if (! *charset) { + set_regex_charset(pmfl, REGEX_ASCII_RESTRICTED_CHARSET); + } + else { + + /* Error if previous modifier wasn't an 'a', but if it was, see + * if, and accept, a second occurrence (only) */ + if (*charset != 'a' + || get_regex_charset(*pmfl) + != REGEX_ASCII_RESTRICTED_CHARSET) + { + goto multiple_charsets; + } + set_regex_charset(pmfl, REGEX_ASCII_MORE_RESTRICTED_CHARSET); + } + *charset = c; + break; + case DEPENDS_PAT_MOD: + if (*charset) { + goto multiple_charsets; + } + set_regex_charset(pmfl, REGEX_DEPENDS_CHARSET); + *charset = c; + break; + } + + (*s)++; + return TRUE; + + deprecate: + Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), + "Having no space between pattern and following word is deprecated"); + return FALSE; + + multiple_charsets: + if (*charset != c) { + yyerror(Perl_form(aTHX_ "Regexp modifiers \"/%c\" and \"/%c\" are mutually exclusive", *charset, c)); + } + else if (c == 'a') { + yyerror("Regexp modifier \"/a\" may appear a maximum of twice"); + } + else { + yyerror(Perl_form(aTHX_ "Regexp modifier \"/%c\" may not appear twice", c)); + } + + /* Pretend that it worked, so will continue processing before dieing */ + (*s)++; + return TRUE; } STATIC char * @@ -12172,6 +8937,7 @@ S_scan_pat(pTHX_ char *start, I32 type) char *s = scan_str(start,!!PL_madskills,FALSE); const char * const valid_flags = (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS); + char charset = '\0'; /* character set modifier */ #ifdef PERL_MAD char *modstart; #endif @@ -12213,14 +8979,7 @@ S_scan_pat(pTHX_ char *start, I32 type) #ifdef PERL_MAD modstart = s; #endif - while (*s && strchr(valid_flags, *s)) - pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++); - - if (isALNUM(*s)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), - "Having no space between pattern and following word is deprecated"); - - } + while (*s && S_pmflag(aTHX_ valid_flags, &(pm->op_pmflags), &s, &charset)) {}; #ifdef PERL_MAD if (PL_madskills && modstart != s) { SV* tmptoken = newSVpvn(modstart, s - modstart); @@ -12243,10 +9002,11 @@ STATIC char * S_scan_subst(pTHX_ char *start) { dVAR; - register char *s; + char *s; register PMOP *pm; I32 first_start; I32 es = 0; + char charset = '\0'; /* character set modifier */ #ifdef PERL_MAD char *modstart; #endif @@ -12299,14 +9059,8 @@ S_scan_subst(pTHX_ char *start) s++; es++; } - else if (strchr(S_PAT_MODS, *s)) - pm->op_pmflags = S_pmflag(pm->op_pmflags, *s++); - else { - if (isALNUM(*s)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_SYNTAX), - "Having no space between pattern and following word is deprecated"); - - } + else if (! S_pmflag(aTHX_ S_PAT_MODS, &(pm->op_pmflags), &s, &charset)) + { break; } } @@ -12684,6 +9438,7 @@ S_scan_heredoc(pTHX_ register char *s) if (*s == term && memEQ(s,PL_tokenbuf,len)) { STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr); *(SvPVX(PL_linestr) + off ) = ' '; + lex_grow_linestr(SvCUR(PL_linestr) + SvCUR(herewas) + 1); sv_catsv(PL_linestr,herewas); PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); s = SvPVX(PL_linestr) + off; /* In case PV of PL_linestr moved. */ @@ -12809,7 +9564,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); @@ -14256,7 +11011,7 @@ S_parse_recdescent(pTHX_ int gramtype, I32 fakeeof) SAVEI32(PL_lex_allbrackets); PL_lex_allbrackets = 0; SAVEI8(PL_lex_fakeeof); - PL_lex_fakeeof = fakeeof; + PL_lex_fakeeof = (U8)fakeeof; if(yyparse(gramtype) && !PL_parser->error_count) qerror(Perl_mess(aTHX_ "Parse error")); }