{ WHEN, TOKENTYPE_IVAL, "WHEN" },
{ WHILE, TOKENTYPE_IVAL, "WHILE" },
{ WORD, TOKENTYPE_OPVAL, "WORD" },
- { 0, TOKENTYPE_NONE, 0 }
+ { 0, TOKENTYPE_NONE, NULL }
};
/* dump the returned token in rv, plus any optional arg in yylval */
"\t(Missing semicolon on previous line?)\n");
else if (PL_oldoldbufptr && isIDFIRST_lazy_if(PL_oldoldbufptr,UTF)) {
const char *t;
- for (t = PL_oldoldbufptr; *t && (isALNUM_lazy_if(t,UTF) || *t == ':'); t++)
- /**/;
+ for (t = PL_oldoldbufptr; (isALNUM_lazy_if(t,UTF) || *t == ':'); t++)
+ NOOP;
if (t < PL_bufptr && isSPACE(*t))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"\t(Do you need to predeclare %.*s?)\n",
dVAR;
HV * const hinthv = GvHV(PL_hintgv);
char he_name[32] = "feature_";
- (void) strncpy(&he_name[8], name, 24);
+ (void) my_strlcpy(&he_name[8], name, 24);
return (hinthv && hv_exists(hinthv, he_name, 8 + namelen));
}
e = t + 1;
}
else {
- for (t = s; !isSPACE(*t); t++) ;
+ t = s;
+ while (!isSPACE(*t))
+ t++;
e = t;
}
while (SPACE_OR_TAB(*e) || *e == '\r' || *e == '\f')
STATIC char *
S_skipspace2(pTHX_ register char *s, SV **svp)
{
- char *start = s;
- I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
- I32 startoff = start - SvPVX(PL_linestr);
+ char *start;
+ const I32 bufptroff = PL_bufptr - SvPVX(PL_linestr);
+ const I32 startoff = s - SvPVX(PL_linestr);
+
s = skipspace(s);
PL_bufptr = SvPVX(PL_linestr) + bufptroff;
if (!PL_madskills || !svp)
return;
while (isSPACE(*PL_last_uni))
PL_last_uni++;
- for (s = PL_last_uni; isALNUM_lazy_if(s,UTF) || *s == '-'; s++)
- /**/;
+ s = PL_last_uni;
+ while (isALNUM_lazy_if(s,UTF) || *s == '-')
+ s++;
if ((t = strchr(s, '(')) && t < PL_bufptr)
return;
S_force_ident(pTHX_ register const char *s, int kind)
{
dVAR;
- if (s && *s) {
+ if (*s) {
const STRLEN len = strlen(s);
OP* const o = (OP*)newSVOP(OP_CONST, 0, newSVpvn(s, len));
start_force(PL_curforce);
/* FALL THROUGH */
default:
{
- if (isALNUM(*s) &&
- *s != '_' &&
+ if ((isALPHA(*s) || isDIGIT(*s)) &&
ckWARN(WARN_MISC))
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Unrecognized escape \\%c passed through",
}
}
} else
- gv = 0;
+ gv = NULL;
}
s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
/* start is the beginning of the possible filehandle/object,
IoANY(datasv) = FPTR2DPTR(void *, funcp); /* stash funcp into spare field */
IoFLAGS(datasv) |= IOf_FAKE_DIRP;
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_add func %p (%s)\n",
- IoANY(datasv), SvPV_nolen(datasv)));
+ FPTR2DPTR(void *, IoANY(datasv)),
+ SvPV_nolen(datasv)));
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
SV *datasv;
#ifdef DEBUGGING
- DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p", FPTR2DPTR(XPVIO *, funcp)));
+ DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p",
+ FPTR2DPTR(void*, funcp)));
#endif
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
funcp = DPTR2FPTR(filter_t, IoANY(datasv));
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: via function %p (%s)\n",
- idx, datasv, SvPV_nolen_const(datasv)));
+ idx, (void*)datasv, SvPV_nolen_const(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
}
/* use constant CLASS => 'MyClass' */
- if ((gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV))) {
- SV *sv;
- if (GvCV(gv) && (sv = cv_const_sv(GvCV(gv)))) {
+ gv = gv_fetchpvn_flags(pkgname, len, 0, SVt_PVCV);
+ if (gv && GvCV(gv)) {
+ SV * const sv = cv_const_sv(GvCV(gv));
+ if (sv)
pkgname = SvPV_nolen_const(sv);
- }
}
return gv_stashpv(pkgname, FALSE);
if (PL_realtokenstart < 0 || !CopLINE(PL_curcop))
PL_thistoken = newSVpvn("",0);
else {
- char *tstart = SvPVX(PL_linestr) + PL_realtokenstart;
+ char * const tstart = SvPVX(PL_linestr) + PL_realtokenstart;
PL_thistoken = newSVpvn(tstart, s - tstart);
}
}
}
#endif
if (d) {
- while (*d && !isSPACE(*d)) d++;
- while (SPACE_OR_TAB(*d)) d++;
+ while (*d && !isSPACE(*d))
+ d++;
+ while (SPACE_OR_TAB(*d))
+ d++;
if (*d++ == '-') {
const bool switches_done = PL_doswitches;
if (strnEQ(s,"=>",2)) {
s = force_word(PL_bufptr,WORD,FALSE,FALSE,FALSE);
- DEBUG_T( { S_printbuf(aTHX_
- "### Saw unary minus before =>, forcing word %s\n", s);
- } );
+ DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } );
OPERATOR('-'); /* unary minus */
}
PL_last_uni = PL_oldbufptr;
}
}
if (PL_lex_brackets < PL_lex_formbrack) {
- const char *t;
+ const char *t = s;
#ifdef PERL_STRICT_CR
- for (t = s; SPACE_OR_TAB(*t); t++) ;
+ while (SPACE_OR_TAB(*t))
#else
- for (t = s; SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
+ while (SPACE_OR_TAB(*t) || *t == '\r')
#endif
+ t++;
if (*t == '\n' || *t == '#') {
s--;
PL_expect = XBLOCK;
if (*s == '[') {
PL_tokenbuf[0] = '@';
if (ckWARN(WARN_SYNTAX)) {
- char *t;
- for(t = s + 1;
- isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$';
- t++) ;
+ char *t = s+1;
+
+ while (isSPACE(*t) || isALNUM_lazy_if(t,UTF) || *t == '$')
+ t++;
if (*t++ == ',') {
PL_bufptr = PEEKSPACE(PL_bufptr); /* XXX can realloc */
while (t < PL_bufend && *t != ']')
&& (t = strchr(s, '}')) && (t = strchr(t, '=')))
{
char tmpbuf[sizeof PL_tokenbuf];
- for (t++; isSPACE(*t); t++) ;
+ do {
+ t++;
+ } while (isSPACE(*t));
if (isIDFIRST_lazy_if(t,UTF)) {
STRLEN dummylen;
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE,
&dummylen);
- for (; isSPACE(*t); t++) ;
+ while (isSPACE(*t))
+ t++;
if (*t == ';' && get_cv(tmpbuf, FALSE))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"You need to quote \"%s\"",
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( { S_printbuf(aTHX_ "### Saw number in %s\n", s); } );
+ DEBUG_T( { printbuf("### Saw number in %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Number",s);
TERM(THING);
case '\'':
s = scan_str(s,!!PL_madskills,FALSE);
- DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } );
+ DEBUG_T( { printbuf("### 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,!!PL_madskills,FALSE);
- DEBUG_T( { S_printbuf(aTHX_ "### Saw string before %s\n", s); } );
+ DEBUG_T( { printbuf("### 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,!!PL_madskills,FALSE);
- DEBUG_T( { S_printbuf(aTHX_ "### Saw backtick string before %s\n", s); } );
+ DEBUG_T( { printbuf("### Saw backtick string before %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
if (*s == '(') {
CLINE;
if (cv) {
- for (d = s + 1; SPACE_OR_TAB(*d); d++) ;
+ d = s + 1;
+ while (SPACE_OR_TAB(*d))
+ d++;
if (*d == ')' && (sv = gv_const_sv(gv))) {
s = d + 1;
#ifdef PERL_MAD
bareword:
if (lastchar != '-') {
if (ckWARN(WARN_RESERVED)) {
- for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
+ d = PL_tokenbuf;
+ while (isLOWER(*d))
+ d++;
if (!*d && !gv_stashpv(PL_tokenbuf,FALSE))
Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
PL_tokenbuf);
PUTBACK;
PerlIO_apply_layers(aTHX_ PL_rsfp, NULL,
Perl_form(aTHX_ ":encoding(%"SVf")",
- name));
+ (void*)name));
FREETMPS;
LEAVE;
}
case KEY_our:
case KEY_my:
+ case KEY_state:
PL_in_my = tmp;
s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
if (!PL_in_my_stash) {
char tmpbuf[1024];
PL_bufptr = s;
- sprintf(tmpbuf, "No such class %.1000s", PL_tokenbuf);
+ my_snprintf(tmpbuf, sizeof(tmpbuf), "No such class %.1000s", PL_tokenbuf);
yyerror(tmpbuf);
}
#ifdef PERL_MAD
s = SKIPSPACE1(s);
if (isIDFIRST_lazy_if(s,UTF)) {
const char *t;
- for (d = s; isALNUM_lazy_if(d,UTF); d++) ;
- for (t=d; *t && isSPACE(*t); t++) ;
+ for (d = s; isALNUM_lazy_if(d,UTF);)
+ d++;
+ for (t=d; isSPACE(*t);)
+ t++;
if ( *t && strchr("|&*+-=!?:.", *t) && ckWARN_d(WARN_PRECEDENCE)
/* [perl #16184] */
&& !(t[0] == '=' && t[1] == '>')
if (bad_proto && ckWARN(WARN_SYNTAX))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
"Illegal character in prototype for %"SVf" : %s",
- PL_subname, d);
+ (void*)PL_subname, d);
SvCUR_set(PL_lex_stuff, tmp);
have_proto = TRUE;
if (!have_name)
Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
else if (*s != ';')
- Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname);
+ Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname);
}
#ifdef PERL_MAD
{
dVAR;
register char *d;
- register PADOFFSET tmp = 0;
+ PADOFFSET tmp = 0;
/* pit holds the identifier we read and pending_ident is reset */
char pit = PL_pending_ident;
PL_pending_ident = 0;
}
else {
if (strchr(PL_tokenbuf,':'))
- yyerror(Perl_form(aTHX_ PL_no_myglob,PL_tokenbuf));
+ yyerror(Perl_form(aTHX_ PL_no_myglob,
+ PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf));
yylval.opval = newOP(OP_PADANY, 0);
yylval.opval->op_targ = allocmy(PL_tokenbuf);
I32
Perl_keyword (pTHX_ const char *name, I32 len)
{
- dVAR;
+ dVAR;
switch (len)
{
case 1: /* 5 tokens of length 1 */
switch (name[1])
{
case 'a':
- switch (name[2])
- {
- case 'i':
- if (name[3] == 't')
- { /* wait */
- return -KEY_wait;
- }
+ switch (name[2])
+ {
+ case 'i':
+ if (name[3] == 't')
+ { /* wait */
+ return -KEY_wait;
+ }
- goto unknown;
+ goto unknown;
- case 'r':
- if (name[3] == 'n')
- { /* warn */
- return -KEY_warn;
- }
+ case 'r':
+ if (name[3] == 'n')
+ { /* warn */
+ return -KEY_warn;
+ }
- goto unknown;
+ goto unknown;
- default:
- goto unknown;
- }
+ default:
+ goto unknown;
+ }
case 'h':
if (name[2] == 'e' &&
name[3] == 'n')
{ /* when */
return (FEATURE_IS_ENABLED("switch") ? KEY_when : 0);
- }
+ }
- goto unknown;
+ goto unknown;
- default:
- goto unknown;
- }
+ default:
+ goto unknown;
+ }
default:
goto unknown;
}
- case 5: /* 38 tokens of length 5 */
+ case 5: /* 39 tokens of length 5 */
switch (name[0])
{
case 'B':
{
case 'l':
if (name[2] == 'e' &&
- name[3] == 's' &&
- name[4] == 's')
- { /* bless */
- return -KEY_bless;
- }
+ name[3] == 's' &&
+ name[4] == 's')
+ { /* bless */
+ return -KEY_bless;
+ }
- goto unknown;
+ goto unknown;
case 'r':
if (name[2] == 'e' &&
goto unknown;
case 't':
- if (name[2] == 'u' &&
- name[3] == 'd' &&
- name[4] == 'y')
- { /* study */
- return KEY_study;
- }
+ switch (name[2])
+ {
+ case 'a':
+ if (name[3] == 't' &&
+ name[4] == 'e')
+ { /* state */
+ return (FEATURE_IS_ENABLED("state") ? KEY_state : 0);
+ }
- goto unknown;
+ goto unknown;
+
+ case 'u':
+ if (name[3] == 'd' &&
+ name[4] == 'y')
+ { /* study */
+ return KEY_study;
+ }
+
+ goto unknown;
+
+ default:
+ goto unknown;
+ }
default:
goto unknown;
case 'i':
if (name[4] == 'n' &&
- name[5] == 'e' &&
- name[6] == 'd')
- { /* defined */
- return KEY_defined;
- }
+ name[5] == 'e' &&
+ name[6] == 'd')
+ { /* defined */
+ return KEY_defined;
+ }
- goto unknown;
+ goto unknown;
- default:
- goto unknown;
- }
+ default:
+ goto unknown;
+ }
}
goto unknown;
Perl_croak(aTHX_ ident_too_long);
if (isALNUM(*s)) /* UTF handled below */
*d++ = *s++;
- else if (*s == '\'' && allow_package && isIDFIRST_lazy_if(s+1,UTF)) {
+ else if (allow_package && (*s == '\'') && isIDFIRST_lazy_if(s+1,UTF)) {
*d++ = ':';
*d++ = ':';
s++;
}
- else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
+ else if (allow_package && (s[0] == ':') && (s[1] == ':') && (s[2] != '$')) {
*d++ = *s++;
*d++ = *s++;
}
else if (UTF && UTF8_IS_START(*s) && isALNUM_utf8((U8*)s)) {
char *t = s + UTF8SKIP(s);
+ size_t len;
while (UTF8_IS_CONTINUED(*t) && is_utf8_mark((U8*)t))
t += UTF8SKIP(t);
- if (d + (t - s) > e)
+ len = t - s;
+ if (d + len > e)
Perl_croak(aTHX_ ident_too_long);
- Copy(s, d, t - s, char);
- d += t - s;
+ Copy(s, d, len, char);
+ d += len;
s = t;
}
else {
Perl_croak(aTHX_ ident_too_long);
}
*d = '\0';
- while (s < send && SPACE_OR_TAB(*s)) s++;
+ while (s < send && SPACE_OR_TAB(*s))
+ s++;
if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
if (ckWARN(WARN_AMBIGUOUS) && keyword(dest, d - dest)) {
- const char *brack = *s == '[' ? "[...]" : "{...}";
+ const char * const brack = (*s == '[') ? "[...]" : "{...}";
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of %c{%s%s} resolved to %c%s%s",
funny, dest, brack, funny, dest, brack);
PL_lex_state = LEX_INTERPEND;
PL_expect = XREF;
}
- if (funny == '#')
- funny = '@';
if (PL_lex_state == LEX_NORMAL) {
if (ckWARN(WARN_AMBIGUOUS) &&
(keyword(dest, d - dest) || get_cv(dest, FALSE)))
{
+ if (funny == '#')
+ funny = '@';
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous use of %c{%s} resolved to %c%s",
funny, dest, funny, dest);
sv_catpv(repl, es ? "eval " : "do ");
sv_catpvs(repl, "{");
sv_catsv(repl, PL_lex_repl);
+ if (strchr(SvPVX(PL_lex_repl), '#'))
+ sv_catpvs(repl, "\n");
sv_catpvs(repl, "}");
SvEVALED_on(repl);
SvREFCNT_dec(PL_lex_repl);
e = PL_tokenbuf + sizeof PL_tokenbuf - 1;
if (!outer)
*d++ = '\n';
- for (peek = s; SPACE_OR_TAB(*peek); peek++) ;
+ peek = s;
+ while (SPACE_OR_TAB(*peek))
+ peek++;
if (*peek == '`' || *peek == '\'' || *peek =='"') {
s = peek;
term = *s++;
or if it didn't end, or if we see a newline
*/
- if (len >= sizeof PL_tokenbuf)
+ if (len >= (I32)sizeof PL_tokenbuf)
Perl_croak(aTHX_ "Excessively long <> operator");
if (s >= end)
Perl_croak(aTHX_ "Unterminated <> operator");
filehandle
*/
if (*d == '$') {
- PADOFFSET tmp;
-
/* try to find it in the pad for this block, otherwise find
add symbol table ops
*/
- if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
+ const PADOFFSET tmp = pad_findmy(d);
+ if (tmp != NOT_IN_PAD) {
if (PAD_COMPNAME_FLAGS_isOUR(tmp)) {
HV * const stash = PAD_COMPNAME_OURSTASH(tmp);
HEK * const stashname = HvNAME_HEK(stash);
*/
#ifdef PERL_MAD
if (PL_madskills) {
- char *tstart = SvPVX(PL_linestr) + stuffstart;
+ char * const tstart = SvPVX(PL_linestr) + stuffstart;
if (PL_thisstuff)
sv_catpvn(PL_thisstuff, tstart, PL_bufend - tstart);
else
if (!PL_encoding || UTF) {
#ifdef PERL_MAD
if (PL_madskills) {
- char *tstart = SvPVX(PL_linestr) + stuffstart;
+ char * const tstart = SvPVX(PL_linestr) + stuffstart;
+ const int len = s - start;
if (PL_thisstuff)
- sv_catpvn(PL_thisstuff, tstart, s - tstart);
+ sv_catpvn(PL_thisstuff, tstart, len);
else
- PL_thisstuff = newSVpvn(tstart, s - tstart);
+ PL_thisstuff = newSVpvn(tstart, len);
if (!PL_thisclose && !keep_delims)
PL_thisclose = newSVpvn(s,termlen);
}
#ifdef PERL_MAD
else {
if (PL_madskills) {
- char *tstart = SvPVX(PL_linestr) + stuffstart;
+ char * const tstart = SvPVX(PL_linestr) + stuffstart;
+ const int len = s - tstart - termlen;
if (PL_thisstuff)
- sv_catpvn(PL_thisstuff, tstart, s - tstart - termlen);
+ sv_catpvn(PL_thisstuff, tstart, len);
else
- PL_thisstuff = newSVpvn(tstart, s - tstart - termlen);
+ PL_thisstuff = newSVpvn(tstart, len);
if (!PL_thisclose && !keep_delims)
PL_thisclose = newSVpvn(s - termlen,termlen);
}
while (!needargs) {
if (*s == '.') {
+ t = s+1;
#ifdef PERL_STRICT_CR
- for (t = s+1;SPACE_OR_TAB(*t); t++) ;
+ while (SPACE_OR_TAB(*t))
+ t++;
#else
- for (t = s+1;SPACE_OR_TAB(*t) || *t == '\r'; t++) ;
+ while (SPACE_OR_TAB(*t) || *t == '\r')
+ t++;
#endif
if (*t == '\n' || t == PL_bufend) {
eofmt = TRUE;
PL_multi_end = 0;
}
if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, msg);
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg);
else
qerror(msg);
if (PL_error_count >= 10) {
if (PL_in_eval && SvCUR(ERRSV))
Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
- ERRSV, OutCopFILE(PL_curcop));
+ (void*)ERRSV, OutCopFILE(PL_curcop));
else
Perl_croak(aTHX_ "%s has too many errors.\n",
OutCopFILE(PL_curcop));
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"utf16_textfilter(%p): %d %d (%d)\n",
- utf16_textfilter, idx, maxlen, (int) count));
+ FPTR2DPTR(void *, utf16_textfilter),
+ idx, maxlen, (int) count));
if (count) {
U8* tmps;
I32 newlen;
const I32 count = FILTER_READ(idx+1, sv, maxlen);
DEBUG_P(PerlIO_printf(Perl_debug_log,
"utf16rev_textfilter(%p): %d %d (%d)\n",
- utf16rev_textfilter, idx, maxlen, (int) count));
+ FPTR2DPTR(void *, utf16rev_textfilter),
+ idx, maxlen, (int) count));
if (count) {
U8* tmps;
I32 newlen;