#define yychar (*PL_yycharp)
#define yylval (*PL_yylvalp)
-static const char ident_too_long[] =
- "Identifier too long";
-static const char c_without_g[] =
- "Use of /c modifier is meaningless without /g";
-static const char c_in_subst[] =
- "Use of /c modifier is meaningless in s///";
+static const char ident_too_long[] = "Identifier too long";
static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
/* #define LEX_NOTPARSING 11 is done in perl.h. */
-#define LEX_NORMAL 10
-#define LEX_INTERPNORMAL 9
-#define LEX_INTERPCASEMOD 8
-#define LEX_INTERPPUSH 7
-#define LEX_INTERPSTART 6
-#define LEX_INTERPEND 5
-#define LEX_INTERPENDMAYBE 4
-#define LEX_INTERPCONCAT 3
-#define LEX_INTERPCONST 2
-#define LEX_FORMLINE 1
-#define LEX_KNOWNEXT 0
+#define LEX_NORMAL 10 /* normal code (ie not within "...") */
+#define LEX_INTERPNORMAL 9 /* code within a string, eg "$foo[$x+1]" */
+#define LEX_INTERPCASEMOD 8 /* expecting a \U, \Q or \E etc */
+#define LEX_INTERPPUSH 7 /* starting a new sublex parse level */
+#define LEX_INTERPSTART 6 /* expecting the start of a $var */
+
+ /* at end of code, eg "$x" followed by: */
+#define LEX_INTERPEND 5 /* ... eg not one of [, { or -> */
+#define LEX_INTERPENDMAYBE 4 /* ... eg one of [, { or -> */
+
+#define LEX_INTERPCONCAT 3 /* expecting anything, eg at start of
+ string or after \E, $foo, etc */
+#define LEX_INTERPCONST 2 /* NOT USED */
+#define LEX_FORMLINE 1 /* expecting a format line */
+#define LEX_KNOWNEXT 0 /* next token known; just return it */
+
#ifdef DEBUGGING
static const char* const lex_state_names[] = {
*/
#ifdef DEBUGGING /* Serve -DT. */
-# define REPORT(retval) tokereport(s,(int)retval)
+# define REPORT(retval) tokereport((I32)retval)
#else
# define REPORT(retval) (retval)
#endif
{ BITOROP, TOKENTYPE_OPNUM, "BITOROP" },
{ COLONATTR, TOKENTYPE_NONE, "COLONATTR" },
{ CONTINUE, TOKENTYPE_NONE, "CONTINUE" },
+ { DEFAULT, TOKENTYPE_NONE, "DEFAULT" },
{ DO, TOKENTYPE_NONE, "DO" },
{ DOLSHARP, TOKENTYPE_NONE, "DOLSHARP" },
{ DORDOR, TOKENTYPE_NONE, "DORDOR" },
{ FUNC0SUB, TOKENTYPE_OPVAL, "FUNC0SUB" },
{ FUNC1, TOKENTYPE_OPNUM, "FUNC1" },
{ FUNCMETH, TOKENTYPE_OPVAL, "FUNCMETH" },
+ { GIVEN, TOKENTYPE_IVAL, "GIVEN" },
{ HASHBRACK, TOKENTYPE_NONE, "HASHBRACK" },
{ IF, TOKENTYPE_IVAL, "IF" },
{ LABEL, TOKENTYPE_PVAL, "LABEL" },
{ UNLESS, TOKENTYPE_IVAL, "UNLESS" },
{ UNTIL, TOKENTYPE_IVAL, "UNTIL" },
{ USE, TOKENTYPE_IVAL, "USE" },
+ { WHEN, TOKENTYPE_IVAL, "WHEN" },
{ WHILE, TOKENTYPE_IVAL, "WHILE" },
{ WORD, TOKENTYPE_OPVAL, "WORD" },
{ 0, TOKENTYPE_NONE, 0 }
/* dump the returned token in rv, plus any optional arg in yylval */
STATIC int
-S_tokereport(pTHX_ const char* s, I32 rv)
+S_tokereport(pTHX_ I32 rv)
{
if (DEBUG_T_TEST) {
const char *name = Nullch;
Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", yylval.pval);
break;
case TOKENTYPE_OPVAL:
- if (yylval.opval)
+ if (yylval.opval) {
Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
PL_op_name[yylval.opval->op_type]);
+ if (yylval.opval->op_type == OP_CONST) {
+ Perl_sv_catpvf(aTHX_ report, " %s",
+ SvPEEK(cSVOPx_sv(yylval.opval)));
+ }
+
+ }
else
Perl_sv_catpv(aTHX_ report, "(opval=null)");
break;
}
- Perl_sv_catpvf(aTHX_ report, " at line %"IVdf" [", (IV)CopLINE(PL_curcop));
- if (s - PL_bufptr > 0)
- sv_catpvn(report, PL_bufptr, s - PL_bufptr);
- else {
- if (PL_oldbufptr && *PL_oldbufptr)
- sv_catpv(report, PL_tokenbuf);
- }
- PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen_const(report));
+ PerlIO_printf(Perl_debug_log, "### %s\n\n", SvPV_nolen_const(report));
};
return (int)rv;
}
+
+/* print the buffer with suitable escapes */
+
+STATIC void
+S_printbuf(pTHX_ const char* fmt, const char* s)
+{
+ SV* const tmp = newSVpvn("", 0);
+ PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
+ SvREFCNT_dec(tmp);
+}
+
#endif
/*
if (t < PL_bufptr && isSPACE(*t))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"\t(Do you need to predeclare %.*s?)\n",
- t - PL_oldoldbufptr, PL_oldoldbufptr);
+ (int)(t - PL_oldoldbufptr), PL_oldoldbufptr);
}
else {
assert(s >= oldbp);
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
+ "\t(Missing operator before %.*s?)\n", (int)(s - oldbp), oldbp);
}
}
PL_bufptr = oldbp;
#endif
) {
*tmpbuf = '^';
- tmpbuf[1] = toCTRL(PL_multi_close);
+ tmpbuf[1] = (char)toCTRL(PL_multi_close);
tmpbuf[2] = '\0';
s = tmpbuf;
}
Perl_croak(aTHX_ "Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
}
+#define FEATURE_IS_ENABLED(name, namelen) \
+ ((0 != (PL_hints & HINT_LOCALIZE_HH)) \
+ && feature_is_enabled(name, namelen))
+/*
+ * S_feature_is_enabled
+ * Check whether the named feature is enabled.
+ */
+STATIC bool
+S_feature_is_enabled(pTHX_ char *name, STRLEN namelen)
+{
+ HV * const hinthv = GvHV(PL_hintgv);
+ char he_name[32] = "feature_";
+ (void) strncpy(&he_name[8], name, 24);
+
+ return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
+}
+
/*
* Perl_deprecate
*/
ch = *t;
*t = '\0';
if (t - s > 0) {
+#ifndef USE_ITHREADS
+ const char * const cf = CopFILE(PL_curcop);
+ STRLEN tmplen = cf ? strlen(cf) : 0;
+ if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) {
+ /* must copy *{"::_<(eval N)[oldfilename:L]"}
+ * to *{"::_<newfilename"} */
+ char smallbuf[256], smallbuf2[256];
+ char *tmpbuf, *tmpbuf2;
+ GV **gvp, *gv2;
+ STRLEN tmplen2 = strlen(s);
+ if (tmplen + 3 < sizeof smallbuf)
+ tmpbuf = smallbuf;
+ else
+ Newx(tmpbuf, tmplen + 3, char);
+ if (tmplen2 + 3 < sizeof smallbuf2)
+ tmpbuf2 = smallbuf2;
+ else
+ Newx(tmpbuf2, tmplen2 + 3, char);
+ tmpbuf[0] = tmpbuf2[0] = '_';
+ tmpbuf[1] = tmpbuf2[1] = '<';
+ memcpy(tmpbuf + 2, cf, ++tmplen);
+ memcpy(tmpbuf2 + 2, s, ++tmplen2);
+ ++tmplen; ++tmplen2;
+ gvp = (GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, FALSE);
+ if (gvp) {
+ gv2 = *(GV**)hv_fetch(PL_defstash, tmpbuf2, tmplen2, TRUE);
+ if (!isGV(gv2))
+ gv_init(gv2, PL_defstash, tmpbuf2, tmplen2, FALSE);
+ /* adjust ${"::_<newfilename"} to store the new file name */
+ GvSV(gv2) = newSVpvn(tmpbuf2 + 2, tmplen2 - 2);
+ GvHV(gv2) = (HV*)SvREFCNT_inc(GvHV(*gvp));
+ GvAV(gv2) = (AV*)SvREFCNT_inc(GvAV(*gvp));
+ }
+ if (tmpbuf != smallbuf) Safefree(tmpbuf);
+ if (tmpbuf2 != smallbuf2) Safefree(tmpbuf2);
+ }
+#endif
CopFILE_free(PL_curcop);
CopFILE_set(PL_curcop, s);
}
STATIC I32
S_sublex_start(pTHX)
{
- const register I32 op_type = yylval.ival;
+ register const I32 op_type = yylval.ival;
if (op_type == OP_NULL) {
yylval.opval = PL_lex_op;
}
STATIC char *
-S_tokenize_use(int is_use, char *s) {
+S_tokenize_use(pTHX_ int is_use, char *s) {
if (PL_expect != XSTATE)
yyerror(Perl_form(aTHX_ "\"%s\" not allowed in expression",
is_use ? "use" : "no"));
I32 orig_keyword = 0;
DEBUG_T( {
- PerlIO_printf(Perl_debug_log, "### LEX_%s\n",
- lex_state_names[PL_lex_state]);
+ SV* tmp = newSVpvn("", 0);
+ PerlIO_printf(Perl_debug_log, "### %"IVdf":LEX_%s/X%s %s\n",
+ (IV)CopLINE(PL_curcop),
+ lex_state_names[PL_lex_state],
+ exp_name[PL_expect],
+ pv_display(tmp, s, strlen(s), 0, 60));
+ SvREFCNT_dec(tmp);
} );
/* check if there's an identifier for us to look at */
if (PL_pending_ident)
PL_expect = PL_lex_expect;
PL_lex_defer = LEX_NORMAL;
}
- DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Next token after '%s' was known, type %"IVdf"\n", PL_bufptr,
- (IV)PL_nexttype[PL_nexttoke]); });
-
return REPORT(PL_nexttype[PL_nexttoke]);
/* interpolated case modifiers like \L \U, including \Q and \E.
}
else {
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Saw case modifier at '%s'\n", PL_bufptr); });
+ "### Saw case modifier\n"); });
s = PL_bufptr + 1;
if (s[1] == '\\' && s[2] == 'E') {
PL_bufptr = s + 3;
if (PL_bufptr == PL_bufend)
return REPORT(sublex_done());
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Interpolated variable at '%s'\n", PL_bufptr); });
+ "### Interpolated variable\n"); });
PL_expect = XTERM;
PL_lex_dojoin = (*PL_bufptr == '@');
PL_lex_state = LEX_INTERPNORMAL;
s = PL_bufptr;
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
- DEBUG_T( {
- PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at [%s]\n",
- exp_name[PL_expect], s);
- } );
retry:
switch (*s) {
PL_last_uni = 0;
PL_last_lop = 0;
if (PL_lex_brackets) {
- if (PL_lex_formbrack)
- yyerror("Format not terminated");
- else
- yyerror("Missing right curly or square bracket");
+ yyerror(PL_lex_formbrack
+ ? "Format not terminated"
+ : "Missing right curly or square bracket");
}
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Tokener got EOF\n");
* at least, set argv[0] to the basename of the Perl
* interpreter. So, having found "#!", we'll set it right.
*/
- SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
+ SV * const x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV)); /* $^X */
assert(SvPOK(x) || SvGMAGICAL(x));
if (sv_eq(x, CopFILESV(PL_curcop))) {
sv_setpvn(x, ipath, ipathend - ipath);
if (strnEQ(s,"=>",2)) {
s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw unary minus before =>, forcing word '%s'\n", s);
+ DEBUG_T( { S_printbuf(aTHX_
+ "### Saw unary minus before =>, forcing word %s\n", s);
} );
OPERATOR('-'); /* unary minus */
}
if (ftst) {
PL_last_lop_op = (OPCODE)ftst;
DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw file test %c\n", (int)ftst);
+ "### Saw file test %c\n", (int)tmp);
} );
FTST(ftst);
}
PL_lex_brackets++;
/* FALL THROUGH */
case '~':
+ if (s[1] == '~'
+ && (PL_expect == XOPERATOR || PL_expect == XTERMORDORDOR)
+ && FEATURE_IS_ENABLED("~~", 2))
+ {
+ s += 2;
+ Eop(OP_SMARTMATCH);
+ }
case ',':
tmp = *s++;
OPERATOR(tmp);
context messages from yyerror().
*/
PL_bufptr = s;
- if (!*s)
- yyerror("Unterminated attribute list");
- else
- yyerror(Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list",
- q, *s, q));
+ yyerror( *s
+ ? Perl_form(aTHX_ "Invalid separator character %c%c%c in attribute list", q, *s, q)
+ : "Unterminated attribute list" );
if (attrs)
op_free(attrs);
OPERATOR(':');
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
s = scan_num(s, &yylval);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw number in '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw number in %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Number",s);
TERM(THING);
case '\'':
s = scan_str(s,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw string before '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } );
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
case '"':
s = scan_str(s,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw string before '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } );
if (PL_expect == XOPERATOR) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
case '`':
s = scan_str(s,FALSE,FALSE);
- DEBUG_T( { PerlIO_printf(Perl_debug_log,
- "### Saw backtick string before '%s'\n", s);
- } );
+ DEBUG_T( { S_printbuf(aTHX_ "### Saw backtick string before %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
/* If not a declared subroutine, it's an indirect object. */
/* (But it's an indir obj regardless for sort.) */
+ /* Also, if "_" follows a filetest operator, it's a bareword */
- if ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
+ if (
+ ( !immediate_paren && (PL_last_lop_op == OP_SORT ||
((!gv || !GvCVu(gv)) &&
(PL_last_lop_op != OP_MAPSTART &&
PL_last_lop_op != OP_GREPSTART))))
+ || (PL_tokenbuf[0] == '_' && PL_tokenbuf[1] == '\0'
+ && ((PL_opargs[PL_last_lop_op] & OA_CLASS_MASK) == OA_FILESTATOP))
+ )
{
PL_expect = (PL_last_lop == PL_oldoldbufptr) ? XTERM : XOPERATOR;
goto bareword;
Perl_croak(aTHX_ "CORE::%s is not a keyword", PL_tokenbuf);
if (tmp < 0)
tmp = -tmp;
+ else if (tmp == KEY_require || tmp == KEY_do)
+ /* that's a way to remember we saw "CORE::" */
+ orig_keyword = tmp;
goto reserved_word;
}
goto just_a_word;
case KEY_bless:
LOP(OP_BLESS,XTERM);
+ case KEY_break:
+ FUN0(OP_BREAK);
+
case KEY_chop:
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", 6))
+ 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;
+ otherwise treat it as a control operator.
+ */
+ s = skipspace(s);
+ if (*s == '{')
PREBLOCK(CONTINUE);
+ else
+ FUN0(OP_CONTINUE);
+ }
+ }
case KEY_chdir:
(void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
case KEY_chroot:
UNI(OP_CHROOT);
+ case KEY_default:
+ PREBLOCK(DEFAULT);
+
case KEY_do:
s = skipspace(s);
if (*s == '{')
PRETERMBLOCK(DO);
if (*s != '\'')
s = force_word(s,WORD,TRUE,TRUE,FALSE);
+ if (orig_keyword == KEY_do) {
+ orig_keyword = 0;
+ yylval.ival = 1;
+ }
+ else
+ yylval.ival = 0;
OPERATOR(DO);
case KEY_die:
case KEY_getlogin:
FUN0(OP_GETLOGIN);
+ case KEY_given:
+ yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(GIVEN);
+
case KEY_glob:
set_csh();
LOP(OP_GLOB,XTERM);
/* [perl #16184] */
&& !(t[0] == '=' && t[1] == '>')
) {
+ int len = (int)(d-s);
Perl_warner(aTHX_ packWARN(WARN_PRECEDENCE),
"Precedence problem: open %.*s should be open(%.*s)",
- d - s, s, d - s, s);
+ len, s, len, s);
}
}
LOP(OP_OPEN,XTERM);
else if (*s == '<')
yyerror("<> should be quotes");
}
- UNI(OP_REQUIRE);
+ if (orig_keyword == KEY_require) {
+ orig_keyword = 0;
+ yylval.ival = 1;
+ }
+ else
+ yylval.ival = 0;
+ PL_expect = XTERM;
+ PL_bufptr = s;
+ PL_last_uni = PL_oldbufptr;
+ PL_last_lop_op = OP_REQUIRE;
+ s = skipspace(s);
+ return REPORT( (int)REQUIRE );
case KEY_reset:
UNI(OP_RESET);
else
TOKEN(1); /* force error */
+ case KEY_say:
+ checkcomma(s,PL_tokenbuf,"filehandle");
+ LOP(OP_SAY,XREF);
+
case KEY_chomp:
UNI(OP_CHOMP);
case KEY_vec:
LOP(OP_VEC,XTERM);
+ case KEY_when:
+ yylval.ival = CopLINE(PL_curcop);
+ OPERATOR(WHEN);
+
case KEY_while:
yylval.ival = CopLINE(PL_curcop);
OPERATOR(WHILE);
PL_pending_ident = 0;
DEBUG_T({ PerlIO_printf(Perl_debug_log,
- "### Tokener saw identifier '%s'\n", PL_tokenbuf); });
+ "### Pending identifier '%s'\n", PL_tokenbuf); });
/* if we're in a my(), we can't allow dynamics here.
$foo'bar has already been turned into $foo::bar, so
/* build ops for a bareword */
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf+1, 0));
yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpv(PL_tokenbuf+1, PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : TRUE,
- ((PL_tokenbuf[0] == '$') ? SVt_PV
- : (PL_tokenbuf[0] == '@') ? SVt_PVAV
- : SVt_PVHV));
+ gv_fetchpv(
+ PL_tokenbuf+1,
+ PL_in_eval
+ ? (GV_ADDMULTI | GV_ADDINEVAL)
+ /* If the identifier refers to a stash, don't autovivify it.
+ * Change 24660 had the side effect of causing symbol table
+ * hashes to always be defined, even if they were freshly
+ * created and the only reference in the entire program was
+ * the single statement with the defined %foo::bar:: test.
+ * It appears that all code in the wild doing this actually
+ * wants to know whether sub-packages have been loaded, so
+ * by avoiding auto-vivifying symbol tables, we ensure that
+ * defined %foo::bar:: continues to be false, and the existing
+ * tests still give the expected answers, even though what
+ * they're actually testing has now changed subtly.
+ */
+ : !(*PL_tokenbuf == '%' && *(d = PL_tokenbuf + strlen(PL_tokenbuf) - 1) == ':' && d[-1] == ':'),
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
+ : SVt_PVHV));
return WORD;
}
goto unknown;
}
- case 3: /* 28 tokens of length 3 */
+ case 3: /* 29 tokens of length 3 */
switch (name[0])
{
case 'E':
case 's':
switch (name[1])
{
+ case 'a':
+ if (name[2] == 'y')
+ { /* say */
+ return (FEATURE_IS_ENABLED("say", 3) ? -KEY_say : 0);
+ }
+
+ goto unknown;
+
case 'i':
if (name[2] == 'n')
{ /* sin */
goto unknown;
}
- case 4: /* 40 tokens of length 4 */
+ case 4: /* 41 tokens of length 4 */
switch (name[0])
{
case 'C':
}
case 'w':
- if (name[1] == 'a')
+ switch (name[1])
{
+ case 'a':
switch (name[2])
{
case 'i':
default:
goto unknown;
}
+
+ case 'h':
+ if (name[2] == 'e' &&
+ name[3] == 'n')
+ { /* when */
+ return (FEATURE_IS_ENABLED("switch", 6) ? KEY_when : 0);
}
goto unknown;
goto unknown;
}
- case 5: /* 36 tokens of length 5 */
+ default:
+ goto unknown;
+ }
+
+ case 5: /* 38 tokens of length 5 */
switch (name[0])
{
case 'B':
}
case 'b':
- if (name[1] == 'l' &&
- name[2] == 'e' &&
+ switch (name[1])
+ {
+ case 'l':
+ if (name[2] == 'e' &&
name[3] == 's' &&
name[4] == 's')
{ /* bless */
goto unknown;
+ case 'r':
+ if (name[2] == 'e' &&
+ name[3] == 'a' &&
+ name[4] == 'k')
+ { /* break */
+ return (FEATURE_IS_ENABLED("switch", 6) ? -KEY_break : 0);
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
+
case 'c':
switch (name[1])
{
goto unknown;
}
+ case 'g':
+ if (name[1] == 'i' &&
+ name[2] == 'v' &&
+ name[3] == 'e' &&
+ name[4] == 'n')
+ { /* given */
+ return (FEATURE_IS_ENABLED("switch", 6) ? KEY_given : 0);
+ }
+
+ goto unknown;
+
case 'i':
switch (name[1])
{
goto unknown;
}
- case 7: /* 28 tokens of length 7 */
+ case 7: /* 29 tokens of length 7 */
switch (name[0])
{
case 'D':
goto unknown;
case 'e':
- if (name[2] == 'f' &&
- name[3] == 'i' &&
- name[4] == 'n' &&
+ if (name[2] == 'f')
+ {
+ switch (name[3])
+ {
+ case 'a':
+ if (name[4] == 'u' &&
+ name[5] == 'l' &&
+ name[6] == 't')
+ { /* default */
+ return (FEATURE_IS_ENABLED("switch", 6) ? KEY_default : 0);
+ }
+
+ goto unknown;
+
+ case 'i':
+ if (name[4] == 'n' &&
name[5] == 'e' &&
name[6] == 'd')
{ /* defined */
default:
goto unknown;
}
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
case 'f':
if (name[1] == 'o' &&
while (s < PL_bufend && isSPACE(*s))
s++;
if (*s == ',') {
- int kw;
+ I32 kw;
*s = '\0'; /* XXX If we didn't do this, we could const a lot of toke.c */
kw = keyword(w, s - w) || get_cv(w, FALSE) != 0;
*s = ',';
if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL)
&& ckWARN(WARN_REGEXP))
{
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_without_g);
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" );
}
pm->op_pmpermflags = pm->op_pmflags;
break;
}
- /* /c is not meaningful with s/// */
- if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP))
- {
- Perl_warner(aTHX_ packWARN(WARN_REGEXP), c_in_subst);
+ if ((pm->op_pmflags & PMf_CONTINUE) && ckWARN(WARN_REGEXP)) {
+ Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless in s///" );
}
if (es) {
OutCopFILE(PL_curcop));
}
PL_in_my = 0;
- PL_in_my_stash = Nullhv;
+ PL_in_my_stash = NULL;
return 0;
}
#ifdef __SC__
static void
restore_rsfp(pTHX_ void *f)
{
- PerlIO *fp = (PerlIO*)f;
+ PerlIO * const fp = (PerlIO*)f;
if (PL_rsfp == PerlIO_stdin())
PerlIO_clearerr(PL_rsfp);
}
if (!isALPHA(*pos)) {
- UV rev;
U8 tmpbuf[UTF8_MAXBYTES+1];
- U8 *tmpend;
if (*s == 'v') s++; /* get past 'v' */
sv_setpvn(sv, "", 0);
for (;;) {
- rev = 0;
+ U8 *tmpend;
+ UV rev = 0;
{
/* this is atoi() that tolerates underscores */
const char *end = pos;