#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
{ 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 }
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
*/
if (t - s > 0) {
#ifndef USE_ITHREADS
const char * const cf = CopFILE(PL_curcop);
- if (cf && strlen(cf) > 7 && strnEQ(cf, "(eval ", 6)) {
+ 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 tmplen = strlen(cf);
STRLEN tmplen2 = strlen(s);
if (tmplen + 3 < sizeof smallbuf)
tmpbuf = smallbuf;
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");
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 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 == '{')
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);
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);
/* 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;
projects / p5sagit/p5-mst-13.2.git / blobdiff