#ifdef USE_PURE_BISON
YYSTYPE* yylval_pointer = NULL;
int* yychar_pointer = NULL;
-# ifdef EMBED
-# undef yylval
-# undef yychar
-# endif
+# undef yylval
+# undef yychar
# define yylval (*yylval_pointer)
# define yychar (*yychar_pointer)
# define PERL_YYLEX_PARAM yylval_pointer,yychar_pointer
t - PL_oldoldbufptr, PL_oldoldbufptr);
}
+ else if (s <= oldbp)
+ warn("\t(Missing operator before end of line?)\n");
else
warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
PL_bufptr = oldbp;
}
for (;;) {
STRLEN prevlen;
- while (s < PL_bufend && isSPACE(*s))
- s++;
+ while (s < PL_bufend && isSPACE(*s)) {
+ if (*s++ == '\n' && PL_in_eval && !PL_rsfp)
+ incline(s);
+ }
if (s < PL_bufend && *s == '#') {
while (s < PL_bufend && *s != '\n')
s++;
- if (s < PL_bufend)
+ if (s < PL_bufend) {
s++;
+ if (PL_in_eval && !PL_rsfp) {
+ incline(s);
+ continue;
+ }
+ }
}
if (s < PL_bufend || !PL_rsfp || PL_lex_state != LEX_NORMAL)
return s;
PL_expect = XTERM;
else {
PL_expect = XOPERATOR;
- force_next(')');
- force_next('(');
}
}
PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
if (SvCOMPILED(PL_lex_repl)) {
PL_lex_state = LEX_INTERPNORMAL;
PL_lex_starts++;
+ /* we don't clear PL_lex_repl here, so that we can check later
+ whether this is an evalled subst; that means we rely on the
+ logic to ensure sublex_done() is called again only via the
+ branch (in yylex()) that clears PL_lex_repl, else we'll loop */
}
- else
+ else {
PL_lex_state = LEX_INTERPCONCAT;
- PL_lex_repl = Nullsv;
+ PL_lex_repl = Nullsv;
+ }
return ',';
}
else {
s++;
/* some backslashes we leave behind */
- if (*s && strchr(leaveit, *s)) {
+ if (*leaveit && *s && strchr(leaveit, *s)) {
*d++ = '\\';
*d++ = *s++;
continue;
continue;
}
/* FALL THROUGH */
- /* default action is to copy the quoted character */
default:
- *d++ = *s++;
- continue;
+ {
+ dTHR;
+ if (ckWARN(WARN_UNSAFE) && isALPHA(*s))
+ warner(WARN_UNSAFE,
+ "Unrecognized escape \\%c passed through",
+ *s);
+ /* default action is to copy the quoted character */
+ *d++ = *s++;
+ continue;
+ }
/* \132 indicates an octal constant */
case '0': case '1': case '2': case '3':
* Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
* private use must be set using malloc'd pointers.
*/
-static int filter_debug = 0;
SV *
filter_add(filter_t funcp, SV *datasv)
{
if (!funcp){ /* temporary handy debugging hack to be deleted */
- filter_debug = atoi((char*)datasv);
+ PL_filter_debug = atoi((char*)datasv);
return NULL;
}
if (!PL_rsfp_filters)
if (!SvUPGRADE(datasv, SVt_PVIO))
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
- if (filter_debug)
- warn("filter_add func %p (%s)", funcp, SvPV(datasv,PL_na));
+ if (PL_filter_debug) {
+ STRLEN n_a;
+ warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
+ }
av_unshift(PL_rsfp_filters, 1);
av_store(PL_rsfp_filters, 0, datasv) ;
return(datasv);
void
filter_del(filter_t funcp)
{
- if (filter_debug)
+ if (PL_filter_debug)
warn("filter_del func %p", funcp);
if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
/* Provide a default input filter to make life easy. */
/* Note that we append to the line. This is handy. */
- if (filter_debug)
+ if (PL_filter_debug)
warn("filter_read %d: from rsfp\n", idx);
if (maxlen) {
/* Want a block */
}
/* Skip this filter slot if filter has been deleted */
if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
- if (filter_debug)
+ if (PL_filter_debug)
warn("filter_read %d: skipped (filter deleted)\n", idx);
return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
}
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
- if (filter_debug)
+ if (PL_filter_debug) {
+ STRLEN n_a;
warn("filter_read %d: via function %p (%s)\n",
- idx, funcp, SvPV(datasv,PL_na));
+ idx, funcp, SvPV(datasv,n_a));
+ }
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
*/
if (PL_in_my) {
if (strchr(PL_tokenbuf,':'))
- croak(no_myglob,PL_tokenbuf);
+ croak(PL_no_myglob,PL_tokenbuf);
yylval.opval = newOP(OP_PADANY, 0);
yylval.opval->op_targ = pad_allocmy(PL_tokenbuf);
PL_lex_state = LEX_INTERPCONCAT;
return ')';
}
+ if (PL_lex_inwhat == OP_SUBST && PL_lex_repl && SvCOMPILED(PL_lex_repl)) {
+ if (PL_bufptr != PL_bufend)
+ croak("Bad evalled substitution pattern");
+ PL_lex_repl = Nullsv;
+ }
/* FALLTHROUGH */
case LEX_INTERPCONCAT:
#ifdef DEBUGGING
else
newargv = PL_origargv;
newargv[0] = ipath;
- execv(ipath, newargv);
+ PerlProc_execv(ipath, newargv);
croak("Can't exec %s", ipath);
}
if (d) {
if (PL_expect == XOPERATOR) {
if (ckWARN(WARN_SEMICOLON) && isIDFIRST_lazy(s) && PL_bufptr == PL_linestart) {
PL_curcop->cop_line--;
- warner(WARN_SEMICOLON, warn_nosemi);
+ warner(WARN_SEMICOLON, PL_warn_nosemi);
PL_curcop->cop_line++;
}
BAop(OP_BIT_AND);
for (t++; isSPACE(*t); t++) ;
if (isIDFIRST_lazy(t)) {
t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
- if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
+ for (; isSPACE(*t); t++) ;
+ if (*t == ';' && perl_get_cv(tmpbuf, FALSE))
warner(WARN_SYNTAX,
"You need to quote \"%s\"", tmpbuf);
}
case 'z': case 'Z':
keylookup: {
+ STRLEN n_a;
gv = Nullgv;
gvp = 0;
if (PL_expect == XOPERATOR) {
if (PL_bufptr == PL_linestart) {
PL_curcop->cop_line--;
- warner(WARN_SEMICOLON, warn_nosemi);
+ warner(WARN_SEMICOLON, PL_warn_nosemi);
PL_curcop->cop_line++;
}
else
(PL_oldoldbufptr == PL_last_lop || PL_oldoldbufptr == PL_last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
(PL_expect == XREF
- || ((opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
+ || ((PL_opargs[PL_last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
|| (PL_last_lop_op == OP_ENTERSUB
&& PL_last_proto
&& PL_last_proto[PL_last_proto[0] == ';' ? 1 : 0] == '*')) )
if (gv && GvCVu(gv)) {
CV *cv;
if ((cv = GvCV(gv)) && SvPOK(cv))
- PL_last_proto = SvPV((SV*)cv, PL_na);
+ PL_last_proto = SvPV((SV*)cv, n_a);
for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
if (*d == ')' && (sv = cv_const_sv(cv))) {
s = d + 1;
if (lastchar != '-') {
for (d = PL_tokenbuf; *d && isLOWER(*d); d++) ;
if (!*d)
- warner(WARN_RESERVED, warn_reserved, PL_tokenbuf);
+ warner(WARN_RESERVED, PL_warn_reserved, PL_tokenbuf);
}
}
s = scan_str(s);
if (!s)
missingterm((char*)0);
- if (ckWARN(WARN_SYNTAX) && SvLEN(PL_lex_stuff)) {
+ force_next(')');
+ if (SvCUR(PL_lex_stuff)) {
+ OP *words = Nullop;
+ int warned = 0;
d = SvPV_force(PL_lex_stuff, len);
- for (; len; --len, ++d) {
- if (*d == ',') {
- warner(WARN_SYNTAX,
- "Possible attempt to separate words with commas");
- break;
- }
- if (*d == '#') {
- warner(WARN_SYNTAX,
- "Possible attempt to put comments in qw() list");
- break;
+ while (len) {
+ for (; isSPACE(*d) && len; --len, ++d) ;
+ if (len) {
+ char *b = d;
+ if (!warned && ckWARN(WARN_SYNTAX)) {
+ for (; !isSPACE(*d) && len; --len, ++d) {
+ if (*d == ',') {
+ warner(WARN_SYNTAX,
+ "Possible attempt to separate words with commas");
+ ++warned;
+ }
+ else if (*d == '#') {
+ warner(WARN_SYNTAX,
+ "Possible attempt to put comments in qw() list");
+ ++warned;
+ }
+ }
+ }
+ else {
+ for (; !isSPACE(*d) && len; --len, ++d) ;
+ }
+ words = append_elem(OP_LIST, words,
+ newSVOP(OP_CONST, 0, newSVpvn(b, d-b)));
}
}
+ if (words) {
+ PL_nextval[PL_nexttoke].opval = words;
+ force_next(THING);
+ }
}
- force_next(')');
- PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(PL_lex_stuff));
+ if (PL_lex_stuff)
+ SvREFCNT_dec(PL_lex_stuff);
PL_lex_stuff = Nullsv;
- force_next(THING);
- force_next(',');
- PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
- force_next(THING);
- force_next('(');
- yylval.ival = OP_SPLIT;
- CLINE;
PL_expect = XTERM;
- PL_bufptr = s;
- PL_last_lop = PL_oldbufptr;
- PL_last_lop_op = OP_SPLIT;
- return FUNC;
+ TOKEN('(');
case KEY_qq:
s = scan_str(s);
PL_lex_stuff = Nullsv;
}
- if (*SvPV(PL_subname,PL_na) == '?') {
+ if (*SvPV(PL_subname,n_a) == '?') {
sv_setpv(PL_subname,"__ANON__");
TOKEN(ANONSUB);
}
bool oldcatch = CATCH_GET;
SV **cvp;
SV *cv, *typesv;
- char buf[128];
if (!table) {
yyerror("%^H is not defined");
}
cvp = hv_fetch(table, key, strlen(key), FALSE);
if (!cvp || !SvOK(*cvp)) {
+ char buf[128];
sprintf(buf,"$^H{%s} is not defined", key);
yyerror(buf);
return sv;
POPSTACK;
if (!SvOK(res)) {
+ char buf[128];
sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
yyerror(buf);
}
if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
OP *o = newOP(OP_PADSV, 0);
o->op_targ = tmp;
- PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
+ PL_lex_op = (OP*)newUNOP(OP_READLINE, 0, o);
}
else {
GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
PL_lex_op = (OP*)newUNOP(OP_READLINE, 0,
- newUNOP(OP_RV2GV, 0,
newUNOP(OP_RV2SV, 0,
- newGVOP(OP_GV, 0, gv))));
+ newGVOP(OP_GV, 0, gv)));
}
- /* we created the ops in lex_op, so make yylval.ival a null op */
+ PL_lex_op->op_flags |= OPf_SPECIAL;
+ /* we created the ops in PL_lex_op, so make yylval.ival a null op */
yylval.ival = OP_NULL;
}
Read a number in any of the formats that Perl accepts:
- 0(x[0-7A-F]+)|([0-7]+)
+ 0(x[0-7A-F]+)|([0-7]+)|(b[01])
[\d_]+(\.[\d_]*)?[Ee](\d+)
Underbars (_) are allowed in decimal numbers. If -w is on,
croak("panic: scan_num");
/* if it starts with a 0, it could be an octal number, a decimal in
- 0.13 disguise, or a hexadecimal number.
+ 0.13 disguise, or a hexadecimal number, or a binary number.
*/
case '0':
{
/* variables:
u holds the "number so far"
- shift the power of 2 of the base (hex == 4, octal == 3)
+ shift the power of 2 of the base
+ (hex == 4, octal == 3, binary == 1)
overflowed was the number more than we can hold?
Shift is used when we add a digit. It also serves as an "are
- we in octal or hex?" indicator to disallow hex characters when
- in octal mode.
+ we in octal/hex/binary?" indicator to disallow hex characters
+ when in octal mode.
*/
UV u;
I32 shift;
if (s[1] == 'x') {
shift = 4;
s += 2;
+ } else if (s[1] == 'b') {
+ shift = 1;
+ s += 2;
}
/* check for a decimal in disguise */
else if (s[1] == '.')
shift = 3;
u = 0;
- /* read the rest of the octal number */
+ /* read the rest of the number */
for (;;) {
UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
/* 8 and 9 are not octal */
case '8': case '9':
- if (shift != 4)
+ if (shift == 3)
yyerror("Illegal octal digit");
+ else
+ if (shift == 1)
+ yyerror("Illegal binary digit");
/* FALL THROUGH */
/* octal digits */
- case '0': case '1': case '2': case '3': case '4':
+ case '2': case '3': case '4':
case '5': case '6': case '7':
+ if (shift == 1)
+ yyerror("Illegal binary digit");
+ /* FALL THROUGH */
+
+ case '0': case '1':
b = *s++ & 15; /* ASCII digit -> value of digit */
goto digit;
if (!overflowed && (n >> shift) != u
&& !(PL_hints & HINT_NEW_BINARY)) {
warn("Integer overflow in %s number",
- (shift == 4) ? "hex" : "octal");
+ (shift == 4) ? "hex"
+ : ((shift == 3) ? "octal" : "binary"));
overflowed = TRUE;
}
u = n | b; /* add the digit to the end */
#else
for (t = s+1;*t == ' ' || *t == '\t' || *t == '\r'; t++) ;
#endif
- if (*t == '\n')
+ if (*t == '\n' || t == PL_bufend)
break;
}
if (PL_in_eval && !PL_rsfp) {