? isALNUM(*(p)) \
: isALNUM_utf8((U8*)p))
+/* In variables name $^X, these are the legal values for X.
+ * 1999-02-27 mjd-perl-patch@plover.com */
+#define isCONTROLVAR(x) (isUPPER(x) || strchr("[\\]^_?", (x)))
+
/* The following are arranged oddly so that the guard on the switch statement
* can get by with a single comparison (if the compiler is smart enough).
*/
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;
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 {
* 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) {
+ if (PL_filter_debug) {
STRLEN n_a;
warn("filter_add func %p (%s)", funcp, SvPV(datasv, n_a));
}
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,n_a));
*/
if (PL_in_my) {
if (strchr(PL_tokenbuf,':'))
- croak(PL_no_myglob,PL_tokenbuf);
+ yyerror(form(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_linestr == 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) {
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);
if (s < send)
*d = *s++;
d[1] = '\0';
- if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
+ if (*d == '^' && *s && isCONTROLVAR(*s)) {
*d = toCTRL(*s);
s++;
}
s = e;
}
else {
- while (isALNUM(*s) || *s == ':')
+ while ((isALNUM(*s) || *s == ':') && d < e)
*d++ = *s++;
+ if (d >= e)
+ croak(ident_too_long);
}
*d = '\0';
while (s < send && (*s == ' ' || *s == '\t')) s++;
PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
return s;
}
+ }
+ /* Handle extended ${^Foo} variables
+ * 1999-02-27 mjd-perl-patch@plover.com */
+ else if (!isALNUM(*d) && !isPRINT(*d) /* isCTRL(d) */
+ && isALNUM(*s))
+ {
+ d++;
+ while (isALNUM(*s) && d < e) {
+ *d++ = *s++;
+ }
+ if (d >= e)
+ croak(ident_too_long);
+ *d = '\0';
}
if (*s == '}') {
s++;
if (es) {
SV *repl;
+ PL_sublex_info.super_bufptr = s;
+ PL_sublex_info.super_bufend = PL_bufend;
+ PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
repl = newSVpv("",0);
while (es-- > 0)
PL_multi_start = PL_curcop->cop_line;
PL_multi_open = PL_multi_close = '<';
term = *PL_tokenbuf;
- if (!outer) {
+ if (PL_lex_inwhat == OP_SUBST && PL_in_eval && !PL_rsfp) {
+ char *bufptr = PL_sublex_info.super_bufptr;
+ char *bufend = PL_sublex_info.super_bufend;
+ char *olds = s - SvCUR(herewas);
+ s = strchr(bufptr, '\n');
+ if (!s)
+ s = bufend;
+ d = s;
+ while (s < bufend &&
+ (*s != term || memNE(s,PL_tokenbuf,len)) ) {
+ if (*s++ == '\n')
+ PL_curcop->cop_line++;
+ }
+ if (s >= bufend) {
+ PL_curcop->cop_line = PL_multi_start;
+ missingterm(PL_tokenbuf);
+ }
+ sv_setpvn(herewas,bufptr,d-bufptr+1);
+ sv_setpvn(tmpstr,d+1,s-d);
+ s += len - 1;
+ sv_catpvn(herewas,s,bufend-s);
+ (void)strcpy(bufptr,SvPVX(herewas));
+
+ s = olds;
+ goto retval;
+ }
+ else if (!outer) {
d = s;
while (s < PL_bufend &&
(*s != term || memNE(s,PL_tokenbuf,len)) ) {
sv_catsv(tmpstr,PL_linestr);
}
}
- PL_multi_end = PL_curcop->cop_line;
s++;
+retval:
+ PL_multi_end = PL_curcop->cop_line;
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
projects / p5sagit/p5-mst-13.2.git / blobdiff