void
lex_end()
{
+ doextract = FALSE;
}
static void
#define LOP(f,x) return lop(f,x,s)
static I32
-lop(f,x,s)
+lop
+#ifdef CAN_PROTOTYPE
+ (I32 f, expectation x, char *s)
+#else
+ (f,x,s)
I32 f;
expectation x;
char *s;
+#endif /* CAN_PROTOTYPE */
{
yylval.ival = f;
CLINE;
if (gv) {
if (GvIO(gv))
return 0;
- if (!GvCV(gv))
+ if (!GvCVu(gv))
gv = 0;
}
s = scan_word(s, tmpbuf, TRUE, &len);
}
if (!keyword(tmpbuf, len)) {
indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV);
- if (indirgv && GvCV(indirgv))
+ if (indirgv && GvCVu(indirgv))
return 0;
/* filehandle or package name makes it a method */
if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
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 %lx (%s)", funcp, SvPV(datasv,na));
+ warn("filter_add func %p (%s)", funcp, SvPV(datasv,na));
av_unshift(rsfp_filters, 1);
av_store(rsfp_filters, 0, datasv) ;
return(datasv);
filter_t funcp;
{
if (filter_debug)
- warn("filter_del func %lx", funcp);
+ warn("filter_del func %p", funcp);
if (!rsfp_filters || AvFILL(rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
if (filter_debug)
- warn("filter_read %d: via function %lx (%s)\n",
+ warn("filter_read %d: via function %p (%s)\n",
idx, funcp, SvPV(datasv,na));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
#endif
-extern int yychar; /* last token */
+EXT int yychar; /* last token */
int
yylex()
s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
s++;
- if (!in_eval && *s == '#' && s[1] == '!') {
+ d = Nullch;
+ if (!in_eval) {
+ if (*s == '#' && *(s+1) == '!')
+ d = s + 2;
+#ifdef ALTERNATE_SHEBANG
+ else {
+ static char as[] = ALTERNATE_SHEBANG;
+ if (*s == as[0] && strnEQ(s, as, sizeof(as) - 1))
+ d = s + (sizeof(as) - 1);
+ }
+#endif /* ALTERNATE_SHEBANG */
+ }
+ if (d) {
+ char *ipath;
+ char *ipathend;
+
+ while (isSPACE(*d))
+ d++;
+ ipath = d;
+ while (*d && !isSPACE(*d))
+ d++;
+ ipathend = d;
+
+#ifdef ARG_ZERO_IS_SCRIPT
+ if (ipathend > ipath) {
+ /*
+ * HP-UX (at least) sets argv[0] to the script name,
+ * which makes $^X incorrect. And Digital UNIX and Linux,
+ * at least, set argv[0] to the basename of the Perl
+ * interpreter. So, having found "#!", we'll set it right.
+ */
+ SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
+ assert(SvPOK(x) || SvGMAGICAL(x));
+ if (sv_eq(x, GvSV(curcop->cop_filegv)))
+ sv_setpvn(x, ipath, ipathend - ipath);
+ TAINT_NOT; /* $^X is always tainted, but that's OK */
+ }
+#endif /* ARG_ZERO_IS_SCRIPT */
+
+ /*
+ * Look for options.
+ */
d = instr(s,"perl -");
if (!d)
d = instr(s,"perl");
+#ifdef ALTERNATE_SHEBANG
+ /*
+ * If the ALTERNATE_SHEBANG on this system starts with a
+ * character that can be part of a Perl expression, then if
+ * we see it but not "perl", we're probably looking at the
+ * start of Perl code, not a request to hand off to some
+ * other interpreter. Similarly, if "perl" is there, but
+ * not in the first 'word' of the line, we assume the line
+ * contains the start of the Perl program.
+ */
+ if (d && *s != '#') {
+ char *c = ipath;
+ while (*c && !strchr("; \t\r\n\f\v#", *c))
+ c++;
+ if (c < d)
+ d = Nullch; /* "perl" not in first word; ignore */
+ else
+ *s = '#'; /* Don't try to parse shebang line */
+ }
+#endif /* ALTERNATE_SHEBANG */
if (!d &&
+ *s == '#' &&
+ ipathend > ipath &&
!minus_c &&
!instr(s,"indir") &&
instr(origargv[0],"perl"))
{
char **newargv;
- char *cmd;
- s += 2;
- if (*s == ' ')
- s++;
- cmd = s;
- while (s < bufend && !isSPACE(*s))
- s++;
- *s++ = '\0';
+ *ipathend = '\0';
+ s = ipathend + 1;
while (s < bufend && isSPACE(*s))
s++;
if (s < bufend) {
}
else
newargv = origargv;
- newargv[0] = cmd;
- execv(cmd,newargv);
- croak("Can't exec %s", cmd);
+ newargv[0] = ipath;
+ execv(ipath, newargv);
+ croak("Can't exec %s", ipath);
}
if (d) {
int oldpdb = perldb;
return yylex();
}
goto retry;
- case ' ': case '\t': case '\f': case '\r': case 013:
+ case '\r':
+ croak("Illegal character \\%03o (carriage return)", '\r');
+ case ' ': case '\t': case '\f': case 013:
s++;
goto retry;
case '#':
if (strnEQ(s,"=>",2)) {
if (dowarn)
warn("Ambiguous use of -%c => resolved to \"-%c\" =>",
- tmp, tmp);
+ (int)tmp, (int)tmp);
s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
OPERATOR('-'); /* unary minus */
}
case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
default:
- croak("Unrecognized file test: -%c", tmp);
+ croak("Unrecognized file test: -%c", (int)tmp);
break;
}
}
case XOPERATOR:
while (s < bufend && (*s == ' ' || *s == '\t'))
s++;
- if (s < bufend && isIDFIRST(*s)) {
- d = scan_word(s, tokenbuf, FALSE, &len);
+ d = s;
+ tokenbuf[0] = '\0';
+ if (d < bufend && *d == '-') {
+ tokenbuf[0] = '-';
+ d++;
+ while (d < bufend && (*d == ' ' || *d == '\t'))
+ d++;
+ }
+ if (d < bufend && isIDFIRST(*d)) {
+ d = scan_word(d, tokenbuf + 1, FALSE, &len);
while (d < bufend && (*d == ' ' || *d == '\t'))
d++;
if (*d == '}') {
+ char minus = (tokenbuf[0] == '-');
if (dowarn &&
- (keyword(tokenbuf, len) ||
- perl_get_cv(tokenbuf, FALSE) ))
+ (keyword(tokenbuf + 1, len) ||
+ (minus && len == 1 && isALPHA(tokenbuf[1])) ||
+ perl_get_cv(tokenbuf + 1, FALSE) ))
warn("Ambiguous use of {%s} resolved to {\"%s\"}",
- tokenbuf, tokenbuf);
- s = force_word(s,WORD,FALSE,TRUE,FALSE);
+ tokenbuf + !minus, tokenbuf + !minus);
+ s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
+ if (minus)
+ force_next('-');
}
}
/* FALL THROUGH */
bufptr = s;
return yylex(); /* ignore fake brackets */
}
- if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+ if (*s == '-' && s[1] == '>')
+ lex_state = LEX_INTERPENDMAYBE;
+ else if (*s != '[' && *s != '{')
lex_state = LEX_INTERPEND;
}
}
if (tmp == '~')
PMop(OP_MATCH);
if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
- warn("Reversed %c= operator",tmp);
+ warn("Reversed %c= operator",(int)tmp);
s--;
if (expect == XSTATE && isALPHA(tmp) &&
(s == linestart+1 || s[-2] == '\n') )
keylookup:
bufptr = s;
s = scan_word(s, tokenbuf, FALSE, &len);
-
- if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
+
+ /* Some keywords can be followed by any delimiter, including ':' */
+ tmp = (len == 1 && strchr("msyq", tokenbuf[0]) ||
+ len == 2 && ((tokenbuf[0] == 't' && tokenbuf[1] == 'r') ||
+ (tokenbuf[0] == 'q' &&
+ strchr("qwx", tokenbuf[1]))));
+
+ /* x::* is just a word, unless x is "CORE" */
+ if (!tmp && *s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
goto just_a_word;
d = s;
d++; /* no comments skipped here, or s### is misparsed */
/* Is this a label? */
- if (expect == XSTATE && d < bufend && *d == ':' && *(d + 1) != ':') {
+ if (!tmp && expect == XSTATE
+ && d < bufend && *d == ':' && *(d + 1) != ':') {
s = d + 1;
yylval.pval = savepv(tokenbuf);
CLINE;
/* (But it's an indir obj regardless for sort.) */
if ((last_lop_op == OP_SORT ||
- (!immediate_paren && (!gv || !GvCV(gv))) ) &&
+ (!immediate_paren && (!gv || !GvCVu(gv))) ) &&
(last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
goto bareword;
/* If followed by var or block, call it a method (unless sub) */
- if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
+ if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
last_lop = oldbufptr;
last_lop_op = OP_METHOD;
PREBLOCK(METHOD);
/* Not a method, so call it a subroutine (if defined) */
- if (gv && GvCV(gv)) {
+ if (gv && GvCVu(gv)) {
CV* cv = GvCV(gv);
if (*s == '(') {
nextval[nexttoke].opval = yylval.opval;
case KEY_if:
yylval.ival = curcop->cop_line;
- PRETERMBLOCK(IF);
+ OPERATOR(IF);
case KEY_index:
LOP(OP_INDEX,XTERM);
case KEY_until:
yylval.ival = curcop->cop_line;
- PRETERMBLOCK(UNTIL);
+ OPERATOR(UNTIL);
case KEY_unless:
yylval.ival = curcop->cop_line;
- PRETERMBLOCK(UNLESS);
+ OPERATOR(UNLESS);
case KEY_unlink:
LOP(OP_UNLINK,XTERM);
case KEY_while:
yylval.ival = curcop->cop_line;
- PRETERMBLOCK(WHILE);
+ OPERATOR(WHILE);
case KEY_warn:
hints |= HINT_BLOCK_SCOPE;
return s;
}
if (*s == '$' && s[1] &&
- (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) )
+ (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
return s;
if (*s == '{') {
bracket = s;
}
if (bracket) {
if (isSPACE(s[-1])) {
- while (s < send && (*s == ' ' || *s == '\t')) s++;
- *d = *s;
+ while (s < send) {
+ char ch = *s++;
+ if (ch != ' ' && ch != '\t') {
+ *d = ch;
+ break;
+ }
+ }
}
if (isIDFIRST(*d)) {
d++;
{
register char *s;
register PMOP *pm;
+ I32 first_start;
I32 es = 0;
yylval.ival = OP_NULL;
if (s[-1] == multi_open)
s--;
+ first_start = multi_start;
s = scan_str(s);
if (!s) {
if (lex_stuff)
lex_repl = Nullsv;
croak("Substitution replacement not terminated");
}
+ multi_start = first_start; /* so whole substitution is taken together */
pm = (PMOP*)newPMOP(OP_SUBST, 0);
while (*s && strchr("iogmsex", *s)) {
return;
}
}
- if (!pm->op_pmshort || /* promote the better string */
- ((pm->op_pmflags & PMf_SCANFIRST) &&
- (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
+ /* promote the better string */
+ if ((!pm->op_pmshort && !(pm->op_pmregexp->reganch & ROPT_ANCH)) ||
+ ((pm->op_pmflags & PMf_SCANFIRST) &&
+ (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
SvREFCNT_dec(pm->op_pmshort); /* ok if null */
pm->op_pmshort = pm->op_pmregexp->regmust;
pm->op_pmslen = SvCUR(pm->op_pmshort);
char term;
register char *d;
char *peek;
+ int outer = (rsfp && !lex_inwhat);
s += 2;
d = tokenbuf;
- if (!rsfp)
+ if (!outer)
*d++ = '\n';
for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
if (*peek && strchr("`'\"",*peek)) {
*d = '\0';
len = d - tokenbuf;
d = "\n";
- if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
+ if (outer || !(d=ninstr(s,bufend,d,d+1)))
herewas = newSVpv(s,bufend-s);
else
s--, herewas = newSVpv(s,d-s);
multi_start = curcop->cop_line;
multi_open = multi_close = '<';
term = *tokenbuf;
- if (!rsfp) {
+ if (!outer) {
d = s;
while (s < bufend &&
(*s != term || memNE(s,tokenbuf,len)) ) {
else
sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
while (s >= bufend) { /* multiple line string? */
- if (!rsfp ||
+ if (!outer ||
!(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
curcop->cop_line = multi_start;
missingterm(tokenbuf);
}
int
-start_subparse()
+start_subparse(is_format, flags)
+I32 is_format;
+U32 flags;
{
int oldsavestack_ix = savestack_ix;
CV* outsidecv = compcv;
SAVEI32(pad_reset_pending);
compcv = (CV*)NEWSV(1104,0);
- sv_upgrade((SV *)compcv, SVt_PVCV);
+ sv_upgrade((SV *)compcv, is_format ? SVt_PVFM : SVt_PVCV);
+ CvFLAGS(compcv) |= flags;
comppad = newAV();
comppad_name = newAV();
(void)sprintf(tname,"next char %c",yychar);
(void)sprintf(buf, "%s at %s line %d, %s\n",
s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
- if (curcop->cop_line == multi_end && multi_start < multi_end) {
+ if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
sprintf(buf+strlen(buf),
- " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
- multi_open,multi_close,(long)multi_start);
+ " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
+ (int)multi_open,(int)multi_close,(long)multi_start);
multi_end = 0;
}
if (in_eval & 2)
https://perl5.git.perl.org / perl5.git / blobdiff