s++;
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
s++;
- if (!in_eval && *s == '#' && s[1] == '!') {
-#ifdef ARG_ZERO_IS_SCRIPT
+ 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.
- * So, having found "#!", we'll set it right.
+ * 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.
*/
- GV *x = gv_fetchpv("\030", TRUE, SVt_PV);
- if (sv_eq(GvSV(x), GvSV(curcop->cop_filegv))) {
- char *a = s + 2;
- while (*a == ' ' || *a == '\t')
- a++;
- d = a;
- while (*d && !isSPACE(*d))
- d++;
- sv_setpvn(GvSV(x), a, d - a);
+ 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;
}
-#endif /* ARG_ZERO_IS_SCRIPT */
+ 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;
}
}
}
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++;
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(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