X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=24805a7d38e38cdf5ffd399c89ce13101d77bf66;hb=fa83b5b6263413f922909c255e021c32c808b32d;hp=a73c6fb24cf6864ff2f3c5ff2b8d794de3f0ff22;hpb=36477c247f3c188fb8cc7e276c87b739d3e6ab7c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index a73c6fb..24805a7 100644 --- a/toke.c +++ b/toke.c @@ -286,6 +286,7 @@ SV *line; void lex_end() { + doextract = FALSE; } static void @@ -1012,7 +1013,7 @@ GV *gv; if (gv) { if (GvIO(gv)) return 0; - if (!GvCV(gv)) + if (!GvCVu(gv)) gv = 0; } s = scan_word(s, tmpbuf, TRUE, &len); @@ -1026,7 +1027,7 @@ GV *gv; } 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)) { @@ -1208,7 +1209,7 @@ STRLEN append; { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" }; #endif -extern int yychar; /* last token */ +EXT int yychar; /* last token */ int yylex() @@ -1565,11 +1566,78 @@ 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")) @@ -1856,17 +1924,29 @@ yylex() 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 */ @@ -1930,7 +2010,9 @@ yylex() 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; } } @@ -2334,16 +2416,34 @@ yylex() 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))) @@ -2383,18 +2483,7 @@ yylex() 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); @@ -2437,7 +2526,7 @@ yylex() /* (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; @@ -2459,7 +2548,7 @@ yylex() /* 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); @@ -2472,7 +2561,7 @@ yylex() /* 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; @@ -4263,8 +4352,13 @@ I32 ck_uni; } 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++; @@ -4975,7 +5069,8 @@ set_csh() } int -start_subparse() +start_subparse(flags) +U32 flags; { int oldsavestack_ix = savestack_ix; CV* outsidecv = compcv; @@ -4997,7 +5092,8 @@ start_subparse() 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();