void
lex_end()
{
+ doextract = FALSE;
}
static void
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)) {
{ "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) {
+ /*
+ * 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));
+ char *ipath;
+ char *ibase;
+
+ while (*d == ' ' || *d == '\t')
+ d++;
+ ipath = d;
+ ibase = Nullch;
+ while (*d && !isSPACE(*d)) {
+ if (*d++ == '/')
+ ibase = d;
+ }
+ assert(SvPOK(x) || SvGMAGICAL(x));
+ if (sv_eq(x, GvSV(curcop->cop_filegv))
+ || (ibase
+ && SvCUR(x) == (d - ibase)
+ && strnEQ(SvPVX(x), ibase, d - ibase)))
+ sv_setpvn(x, ipath, d - ipath);
+ /*
+ * $^X is always tainted, but taintedness must be off
+ * when parsing code, so forget we ever saw it.
+ */
+ TAINT_NOT;
+
+ /*
+ * 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.
+ * This isn't foolproof, but it's generally a good guess.
+ */
+ if (d && *s != '#') {
+ char *c = s;
+ 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
if (!d &&
+ *s == '#' &&
!minus_c &&
!instr(s,"indir") &&
instr(origargv[0],"perl"))
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;
}
}
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;
+ while (d < bufend && isSPACE(*d))
+ d++; /* no comments skipped here, or s### is misparsed */
+
+ /* Is this a label? */
+ if (!tmp && expect == XSTATE
+ && d < bufend && *d == ':' && *(d + 1) != ':') {
+ s = d + 1;
+ yylval.pval = savepv(tokenbuf);
+ CLINE;
+ TOKEN(LABEL);
+ }
+
+ /* Check for keywords */
tmp = keyword(tokenbuf, len);
/* Is this a word before a => operator? */
- d = s;
- while (d < bufend && (*d == ' ' || *d == '\t'))
- d++; /* no comments skipped here, or s### is misparsed */
if (strnEQ(d,"=>",2)) {
CLINE;
if (dowarn && (tmp || perl_get_cv(tokenbuf, FALSE)))
croak("Bad name after %s::", tokenbuf);
}
- /* Do special processing at start of statement. */
-
- if (expect == XSTATE) {
- while (isSPACE(*s)) s++;
- if (*s == ':') { /* It's a label. */
- yylval.pval = savepv(tokenbuf);
- s++;
- CLINE;
- TOKEN(LABEL);
- }
- }
- else if (expect == XOPERATOR) {
+ if (expect == XOPERATOR) {
if (bufptr == linestart) {
curcop->cop_line--;
warn(warn_nosemi);
/* (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;
}
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++;
}
int
-start_subparse()
+start_subparse(flags)
+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, (flags & CVf_FORMAT) ? SVt_PVFM : SVt_PVCV);
+ CvFLAGS(compcv) |= flags;
comppad = newAV();
comppad_name = newAV();
projects / p5sagit/p5-mst-13.2.git / blobdiff