STATIC void
S_tokereport(pTHX_ char *thing, char* s, I32 rv)
{
- SV *report;
DEBUG_T({
- report = newSVpv(thing, 0);
+ SV* report = newSVpv(thing, 0);
Perl_sv_catpvf(aTHX_ report, ":line %d:%"IVdf":", CopLINE(PL_curcop),
(IV)rv);
for (;;) {
STRLEN prevlen;
SSize_t oldprevlen, oldoldprevlen;
- SSize_t oldloplen, oldunilen;
+ SSize_t oldloplen = 0, oldunilen = 0;
while (s < PL_bufend && isSPACE(*s)) {
if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
incline(s);
SAVEI32(PL_lex_inwhat);
SAVECOPLINE(PL_curcop);
SAVEPPTR(PL_bufptr);
+ SAVEPPTR(PL_bufend);
SAVEPPTR(PL_oldbufptr);
SAVEPPTR(PL_oldoldbufptr);
SAVEPPTR(PL_last_lop);
++s;
if (*s == '{') {
char* e = strchr(s, '}');
+ STRLEN len = 1; /* allow underscores */
+
if (!e) {
yyerror("Missing right brace on \\x{}");
- e = s;
- }
- else {
- STRLEN len = 1; /* allow underscores */
- uv = (UV)scan_hex(s + 1, e - s - 1, &len);
+ ++s;
+ continue;
}
+ uv = (UV)scan_hex(s + 1, e - s - 1, &len);
s = e + 1;
}
else {
*d = '\0';
SvCUR_set(sv, d - SvPVX(sv));
if (SvCUR(sv) >= SvLEN(sv))
- Perl_croak(aTHX_ "panic:constant overflowed allocated space");
+ Perl_croak(aTHX_ "panic: constant overflowed allocated space");
SvPOK_on(sv);
if (has_utf8) {
s++;
if (s < d)
s++;
+ else if (s > d) /* Found by Ilya: feed random input to Perl. */
+ Perl_croak(aTHX_ "panic: input overflow");
incline(s);
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_bufptr = s;
else
PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
s = skipspace(s);
- if (*s == '}')
+ if (*s == '}') {
+ if (PL_expect == XREF && PL_lex_state == LEX_INTERPNORMAL) {
+ PL_expect = XTERM;
+ /* This hack is to get the ${} in the message. */
+ PL_bufptr = s+1;
+ yyerror("syntax error");
+ break;
+ }
OPERATOR(HASHBRACK);
+ }
/* This hack serves to disambiguate a pair of curlies
* as being a block or an anon hash. Normally, expectation
* determines that, but in cases where we're not in a
TERM(THING);
}
/* avoid v123abc() or $h{v1}, allow C<print v10;> */
- else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF)) {
+ else if (!isALPHA(*start) && (PL_expect == XTERM || PL_expect == XREF || PL_expect == XSTATE)) {
char c = *start;
GV *gv;
*start = '\0';
CLINE;
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
yylval.opval->op_private = OPpCONST_BARE;
- if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len))
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
TERM(WORD);
}
if (*s == '=' && s[1] == '>') {
CLINE;
sv_setpv(((SVOP*)yylval.opval)->op_sv, PL_tokenbuf);
- if (UTF && !IN_BYTE && is_utf8_string((U8*)PL_tokenbuf, len))
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
TERM(WORD);
}
}
#endif
#ifdef PERLIO_LAYERS
- if (UTF && !IN_BYTE)
+ if (UTF && !IN_BYTES)
PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, ":utf8");
#endif
PL_rsfp = Nullfp;
really_sub:
{
char tmpbuf[sizeof PL_tokenbuf];
- SSize_t tboffset;
+ SSize_t tboffset = 0;
expectation attrful;
bool have_name, have_proto;
int key = tmp;
if (strEQ(d,"rindex")) return -KEY_rindex;
break;
case 7:
- if (strEQ(d,"require")) return -KEY_require;
+ if (strEQ(d,"require")) return KEY_require;
if (strEQ(d,"reverse")) return -KEY_reverse;
if (strEQ(d,"readdir")) return -KEY_readdir;
break;
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
}
SvREFCNT_dec(herewas);
- if (UTF && !IN_BYTE && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)SvPVX(tmpstr), SvCUR(tmpstr)))
SvUTF8_on(tmpstr);
PL_lex_stuff = tmpstr;
yylval.ival = op_type;
Read a number in any of the formats that Perl accepts:
- \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee](\d+) 12 12.34 12.
- \.\d(_?\d)*[Ee](\d+) .34
+ \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*) 12 12.34 12.
+ \.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*) .34
0b[01](_?[01])*
0[0-7](_?[0-7])*
0x[0-9A-Fa-f](_?[0-9A-Fa-f])*
}
/* read exponent part, if present */
- if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
+ if (*s && strchr("eE",*s) && strchr("+-0123456789_", s[1])) {
floatit = TRUE;
s++;
/* regardless of whether user said 3E5 or 3e5, use lower 'e' */
*d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
+ /* stray preinitial _ */
+ if (*s == '_') {
+ if (ckWARN(WARN_SYNTAX))
+ Perl_warner(aTHX_ WARN_SYNTAX,
+ "Misplaced _ in number");
+ lastub = s++;
+ }
+
/* allow positive or negative exponent */
if (*s == '+' || *s == '-')
*d++ = *s++;
- /* read digits of exponent (no underbars :-) */
- while (isDIGIT(*s)) {
- if (d >= e)
- Perl_croak(aTHX_ number_too_long);
- *d++ = *s++;
+ /* stray initial _ */
+ if (*s == '_') {
+ if (ckWARN(WARN_SYNTAX))
+ Perl_warner(aTHX_ WARN_SYNTAX,
+ "Misplaced _ in number");
+ lastub = s++;
+ }
+
+ /* read digits of exponent */
+ while (isDIGIT(*s) || *s == '_') {
+ if (isDIGIT(*s)) {
+ if (d >= e)
+ Perl_croak(aTHX_ number_too_long);
+ *d++ = *s++;
+ }
+ else {
+ if (ckWARN(WARN_SYNTAX) &&
+ ((lastub && s == lastub + 1) ||
+ (!isDIGIT(s[1]) && s[1] != '_')))
+ Perl_warner(aTHX_ WARN_SYNTAX,
+ "Misplaced _ in number");
+ lastub = s++;
+ }
}
}
*/
if (!floatit) {
- IV iv;
- UV uv;
+ IV iv = 0;
+ UV uv = 0;
errno = 0;
if (*PL_tokenbuf == '-')
iv = Strtol(PL_tokenbuf, (char**)NULL, 10);