X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=c6d56edb5c7ce7e602aead94f1724e6a66d9153e;hb=d83e3bda142ab17f4cd2633e1fb9f48644dabcbf;hp=6c582a5a5dd7fc1dac487a70cbc8ebf89dba20f1;hpb=2304df62caa7d9be70e8b8bcdb454e139c9c103d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index 6c582a5..c6d56ed 100644 --- a/toke.c +++ b/toke.c @@ -1,98 +1,69 @@ -/* $RCSfile: toke.c,v $$Revision: 4.1 $$Date: 92/08/07 18:28:39 $ +/* toke.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, Larry Wall * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. * - * $Log: toke.c,v $ - * Revision 4.1 92/08/07 18:28:39 lwall - * - * Revision 4.0.1.7 92/06/11 21:16:30 lwall - * patch34: expect incorrectly set to indicate start of program or block - * - * Revision 4.0.1.6 92/06/08 16:03:49 lwall - * patch20: an EXPR may now start with a bareword - * patch20: print $fh EXPR can now expect term rather than operator in EXPR - * patch20: added ... as variant on .. - * patch20: new warning on spurious backslash - * patch20: new warning on missing $ for foreach variable - * patch20: "foo"x1024 now legal without space after x - * patch20: new warning on print accidentally used as function - * patch20: tr/stuff// wasn't working right - * patch20: 2. now eats the dot - * patch20: <@ARGV> now notices @ARGV - * patch20: tr/// now lets you say \- - * - * Revision 4.0.1.5 91/11/11 16:45:51 lwall - * patch19: default arg for shift was wrong after first subroutine definition - * - * Revision 4.0.1.4 91/11/05 19:02:48 lwall - * patch11: \x and \c were subject to double interpretation in regexps - * patch11: prepared for ctype implementations that don't define isascii() - * patch11: nested list operators could miscount parens - * patch11: once-thru blocks didn't display right in the debugger - * patch11: sort eval "whatever" didn't work - * patch11: underscore is now allowed within literal octal and hex numbers - * - * Revision 4.0.1.3 91/06/10 01:32:26 lwall - * patch10: m'$foo' now treats string as single quoted - * patch10: certain pattern optimizations were botched - * - * Revision 4.0.1.2 91/06/07 12:05:56 lwall - * patch4: new copyright notice - * patch4: debugger lost track of lines in eval - * patch4: //o and s///o now optimize themselves fully at runtime - * patch4: added global modifier for pattern matches - * - * Revision 4.0.1.1 91/04/12 09:18:18 lwall - * patch1: perl -de "print" wouldn't stop at the first statement - * - * Revision 4.0 91/03/20 01:42:14 lwall - * 4.0 baseline. - * + */ + +/* + * "It all comes from here, the stench and the peril." --Frodo */ #include "EXTERN.h" #include "perl.h" -#include "perly.h" -static void set_csh(); +static void check_uni _((void)); +static void force_next _((I32 type)); +static char *force_version _((char *start)); +static char *force_word _((char *start, int token, int check_keyword, int allow_pack, int allow_tick)); +static SV *q _((SV *sv)); +static char *scan_const _((char *start)); +static char *scan_formline _((char *s)); +static char *scan_heredoc _((char *s)); +static char *scan_ident _((char *s, char *send, char *dest, I32 ck_uni)); +static char *scan_inputsymbol _((char *start)); +static char *scan_pat _((char *start)); +static char *scan_str _((char *start)); +static char *scan_subst _((char *start)); +static char *scan_trans _((char *start)); +static char *scan_word _((char *s, char *dest, int allow_package, STRLEN *slp)); +static char *skipspace _((char *s)); +static void checkcomma _((char *s, char *name, char *what)); +static void force_ident _((char *s, int kind)); +static void incline _((char *s)); +static int intuit_method _((char *s, GV *gv)); +static int intuit_more _((char *s)); +static I32 lop _((I32 f, expectation x, char *s)); +static void missingterm _((char *s)); +static void no_op _((char *what, char *s)); +static void set_csh _((void)); +static I32 sublex_done _((void)); +static I32 sublex_start _((void)); +#ifdef CRIPPLED_CC +static int uni _((I32 f, char *s)); +#endif +static char * filter_gets _((SV *sv, PerlIO *fp, STRLEN append)); +static void restore_rsfp _((void *f)); + +static char *linestart; /* beg. of most recently read line */ /* 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). */ -#define LEX_NORMAL 8 -#define LEX_INTERPNORMAL 7 -#define LEX_INTERPCASEMOD 6 -#define LEX_INTERPSTART 5 -#define LEX_INTERPEND 4 -#define LEX_INTERPENDMAYBE 3 -#define LEX_INTERPCONCAT 2 -#define LEX_INTERPCONST 1 +#define LEX_NORMAL 9 +#define LEX_INTERPNORMAL 8 +#define LEX_INTERPCASEMOD 7 +#define LEX_INTERPSTART 6 +#define LEX_INTERPEND 5 +#define LEX_INTERPENDMAYBE 4 +#define LEX_INTERPCONCAT 3 +#define LEX_INTERPCONST 2 +#define LEX_FORMLINE 1 #define LEX_KNOWNEXT 0 -static U32 lex_state = LEX_NORMAL; /* next token is determined */ -static U32 lex_defer; /* state after determined token */ -static expectation lex_expect; /* expect after determined token */ -static I32 lex_brackets; /* bracket count */ -static I32 lex_fakebrack; /* outer bracket is mere delimiter */ -static I32 lex_casemods; /* casemod count */ -static I32 lex_dojoin; /* doing an array interpolation */ -static I32 lex_starts; /* how many interps done on level */ -static SV * lex_stuff; /* runtime pattern from m// or s/// */ -static SV * lex_repl; /* runtime replacement from s/// */ -static OP * lex_op; /* extra info to pass back on op */ -static I32 lex_inpat; /* in pattern $) and $| are special */ -static I32 lex_inwhat; /* what kind of quoting are we in */ -static char * lex_brackstack; /* what kind of brackets to pop */ - -/* What we know when we're in LEX_KNOWNEXT state. */ -static YYSTYPE nextval[5]; /* value of next token, if any */ -static I32 nexttype[5]; /* type of next token */ -static I32 nexttoke = 0; - #ifdef I_FCNTL #include #endif @@ -100,41 +71,41 @@ static I32 nexttoke = 0; #include #endif +/* XXX If this causes problems, set i_unistd=undef in the hint file. */ +#ifdef I_UNISTD +# include /* Needed for execv() */ +#endif + + #ifdef ff_next #undef ff_next #endif #include "keywords.h" -void checkcomma(); - #ifdef CLINE #undef CLINE #endif #define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline)) -#ifdef atarist -#define PERL_META(c) ((c) | 128) -#else -#define META(c) ((c) | 128) -#endif - #define TOKEN(retval) return (bufptr = s,(int)retval) #define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval) +#define AOPERATOR(retval) return ao((expect = XTERM,bufptr = s,(int)retval)) #define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval) +#define PRETERMBLOCK(retval) return (expect = XTERMBLOCK,bufptr = s,(int)retval) #define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval) #define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval) #define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX) #define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP) #define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0) #define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1) -#define BOop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP) -#define BAop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP) -#define SHop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP) -#define PWop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP) +#define BOop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP)) +#define BAop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP)) +#define SHop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP)) +#define PWop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP)) #define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP) -#define Aop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP) -#define Mop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP) +#define Aop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP)) +#define Mop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP)) #define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP) #define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP) @@ -145,6 +116,7 @@ void checkcomma(); expect = XTERM, \ bufptr = s, \ last_uni = oldbufptr, \ + last_lop_op = f, \ (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) ) #define UNIBRACK(f) return(yylval.ival = f, \ @@ -152,31 +124,48 @@ void checkcomma(); last_uni = oldbufptr, \ (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) ) -/* This does similarly for list operators */ -#define LOP(f) return(yylval.ival = f, \ - CLINE, \ - expect = XREF, \ - bufptr = s, \ - last_lop = oldbufptr, \ - last_lop_op = f, \ - (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC : (int)LSTOP) ) - /* grandfather return to old style */ #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP) +static int +ao(toketype) +int toketype; +{ + if (*bufptr == '=') { + bufptr++; + if (toketype == ANDAND) + yylval.ival = OP_ANDASSIGN; + else if (toketype == OROR) + yylval.ival = OP_ORASSIGN; + toketype = ASSIGNOP; + } + return toketype; +} + static void no_op(what, s) char *what; char *s; { char tmpbuf[128]; - char *oldbufptr = bufptr; + char *oldbp = bufptr; + bool is_first = (oldbufptr == linestart); bufptr = s; sprintf(tmpbuf, "%s found where operator expected", what); yywarn(tmpbuf); - if (bufptr == SvPVX(linestr)) - warn("\t(Missing semicolon on previous line?)\n", what); - bufptr = oldbufptr; + if (is_first) + warn("\t(Missing semicolon on previous line?)\n"); + else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) { + char *t; + for (t = oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ; + if (t < bufptr && isSPACE(*t)) + warn("\t(Do you need to predeclare %.*s?)\n", + t - oldoldbufptr, oldoldbufptr); + + } + else + warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp); + bufptr = oldbp; } static void @@ -207,6 +196,20 @@ char *s; } void +deprecate(s) +char *s; +{ + if (dowarn) + warn("Use of %s is deprecated", s); +} + +static void +depcom() +{ + deprecate("comma-less variable list"); +} + +void lex_start(line) SV *line; { @@ -219,27 +222,30 @@ SV *line; SAVEINT(lex_casemods); SAVEINT(lex_starts); SAVEINT(lex_state); - SAVEINT(lex_inpat); + SAVESPTR(lex_inpat); SAVEINT(lex_inwhat); SAVEINT(curcop->cop_line); - SAVESPTR(bufptr); - SAVESPTR(bufend); - SAVESPTR(oldbufptr); - SAVESPTR(oldoldbufptr); + SAVEPPTR(bufptr); + SAVEPPTR(bufend); + SAVEPPTR(oldbufptr); + SAVEPPTR(oldoldbufptr); + SAVEPPTR(linestart); SAVESPTR(linestr); - SAVESPTR(lex_brackstack); - SAVESPTR(rsfp); + SAVEPPTR(lex_brackstack); + SAVEPPTR(lex_casestack); + SAVEDESTRUCTOR(restore_rsfp, rsfp); lex_state = LEX_NORMAL; lex_defer = 0; expect = XSTATE; lex_brackets = 0; lex_fakebrack = 0; - if (lex_brackstack) - SAVESPTR(lex_brackstack); New(899, lex_brackstack, 120, char); + New(899, lex_casestack, 12, char); SAVEFREEPV(lex_brackstack); + SAVEFREEPV(lex_casestack); lex_casemods = 0; + *lex_casestack = '\0'; lex_dojoin = 0; lex_starts = 0; if (lex_stuff) @@ -255,17 +261,15 @@ SV *line; linestr = sv_2mortal(newSVsv(linestr)); s = SvPV(linestr, len); if (len && s[len-1] != ';') { - if (!(SvFLAGS(linestr) & SVs_TEMP)); + if (!(SvFLAGS(linestr) & SVs_TEMP)) linestr = sv_2mortal(newSVsv(linestr)); sv_catpvn(linestr, "\n;", 2); } SvTEMP_off(linestr); - oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr); + oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr); bufend = bufptr + SvCUR(linestr); - rs = "\n"; - rslen = 1; - rschar = '\n'; - rspara = 0; + SvREFCNT_dec(rs); + rs = newSVpv("\n", 1); rsfp = 0; } @@ -275,6 +279,19 @@ lex_end() } static void +restore_rsfp(f) +void *f; +{ + PerlIO *fp = (PerlIO*)f; + + if (rsfp == PerlIO_stdin()) + PerlIO_clearerr(rsfp); + else if (rsfp && (rsfp != fp)) + PerlIO_close(rsfp); + rsfp = fp; +} + +static void incline(s) char *s; { @@ -319,12 +336,13 @@ static char * skipspace(s) register char *s; { - if (in_format && lex_brackets <= 1) { + if (lex_formbrack && lex_brackets <= lex_formbrack) { while (s < bufend && (*s == ' ' || *s == '\t')) s++; return s; } for (;;) { + STRLEN prevlen; while (s < bufend && isSPACE(*s)) s++; if (s < bufend && *s == '#') { @@ -333,31 +351,38 @@ register char *s; if (s < bufend) s++; } - if (s < bufend || !rsfp) + if (s < bufend || !rsfp || lex_state != LEX_NORMAL) return s; - if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) { - sv_setpv(linestr,";"); - oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr); - bufend = s+1; - if (preprocess) + if ((s = filter_gets(linestr, rsfp, (prevlen = SvCUR(linestr)))) == Nullch) { + if (minus_n || minus_p) { + sv_setpv(linestr,minus_p ? ";}continue{print" : ""); + sv_catpv(linestr,";}"); + minus_n = minus_p = 0; + } + else + sv_setpv(linestr,";"); + oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); + if (preprocess && !in_eval) (void)my_pclose(rsfp); - else if ((FILE*)rsfp == stdin) - clearerr(stdin); + else if ((PerlIO*)rsfp == PerlIO_stdin()) + PerlIO_clearerr(rsfp); else - (void)fclose(rsfp); + (void)PerlIO_close(rsfp); rsfp = Nullfp; return s; } - oldoldbufptr = oldbufptr = bufptr = s; - bufend = bufptr + SvCUR(linestr); + linestart = bufptr = s + prevlen; + bufend = s + SvCUR(linestr); + s = bufptr; + incline(s); if (perldb && curstash != debstash) { SV *sv = NEWSV(85,0); sv_upgrade(sv, SVt_PVMG); - sv_setsv(sv,linestr); + sv_setpvn(sv,bufptr,bufend-bufptr); av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv); } - incline(s); } } @@ -365,12 +390,15 @@ static void check_uni() { char *s; char ch; + char *t; if (oldoldbufptr != last_uni) return; while (isSPACE(*last_uni)) last_uni++; for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ; + if ((t = strchr(s, '(')) && t < bufptr) + return; ch = *s; *s = '\0'; warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni); @@ -380,9 +408,7 @@ check_uni() { #ifdef CRIPPLED_CC #undef UNI -#undef LOP #define UNI(f) return uni(f,s) -#define LOP(f) return lop(f,s) static int uni(f,s) @@ -393,6 +419,7 @@ char *s; expect = XTERM; bufptr = s; last_uni = oldbufptr; + last_lop_op = f; if (*s == '(') return FUNC1; s = skipspace(s); @@ -402,17 +429,24 @@ char *s; return UNIOP; } +#endif /* CRIPPLED_CC */ + +#define LOP(f,x) return lop(f,x,s) + static I32 -lop(f,s) +lop(f,x,s) I32 f; +expectation x; char *s; { yylval.ival = f; CLINE; - expect = XREF; + expect = x; bufptr = s; last_lop = oldbufptr; last_lop_op = f; + if (nexttoke) + return LSTOP; if (*s == '(') return FUNC; s = skipspace(s); @@ -422,8 +456,6 @@ char *s; return LSTOP; } -#endif /* CRIPPLED_CC */ - static void force_next(type) I32 type; @@ -438,10 +470,11 @@ I32 type; } static char * -force_word(start,token,check_keyword,allow_tick) +force_word(start,token,check_keyword,allow_pack,allow_tick) register char *start; int token; int check_keyword; +int allow_pack; int allow_tick; { register char *s; @@ -449,8 +482,11 @@ int allow_tick; start = skipspace(start); s = start; - if (isIDFIRST(*s) || (allow_tick && (*s == '\'' || *s == ':'))) { - s = scan_word(s, tokenbuf, allow_tick, &len); + if (isIDFIRST(*s) || + (allow_pack && *s == ':') || + (allow_tick && *s == '\'') ) + { + s = scan_word(s, tokenbuf, allow_pack, &len); if (check_keyword && keyword(tokenbuf, len)) return start; if (token == METHOD) { @@ -471,13 +507,52 @@ int allow_tick; } static void -force_ident(s) +force_ident(s, kind) register char *s; +int kind; { if (s && *s) { - nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); + OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0)); + nextval[nexttoke].opval = op; force_next(WORD); + if (kind) { + op->op_private = OPpCONST_ENTERED; + gv_fetchpv(s, TRUE, + kind == '$' ? SVt_PV : + kind == '@' ? SVt_PVAV : + kind == '%' ? SVt_PVHV : + SVt_PVGV + ); + } + } +} + +static char * +force_version(s) +char *s; +{ + OP *version = Nullop; + + s = skipspace(s); + + /* default VERSION number -- GBARR */ + + if(isDIGIT(*s)) { + char *d; + int c; + for( d=s, c = 1; isDIGIT(*d) || (*d == '.' && c--); d++); + if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') { + s = scan_num(s); + /* real VERSION number -- GBARR */ + version = yylval.opval; + } } + + /* NOTE: The parser sees the package name and the VERSION swapped */ + nextval[nexttoke].opval = version; + force_next(WORD); + + return (s); } static SV * @@ -487,23 +562,23 @@ SV *sv; register char *s; register char *send; register char *d; - register char delim; STRLEN len; if (!SvLEN(sv)) return sv; - s = SvPV(sv, len); + s = SvPV_force(sv, len); + if (SvIVX(sv) == -1) + return sv; send = s + len; while (s < send && *s != '\\') s++; if (s == send) return sv; d = s; - delim = SvIVX(sv); while (s < send) { if (*s == '\\') { - if (s + 1 < send && (s[1] == '\\' || s[1] == delim)) + if (s + 1 < send && (s[1] == '\\')) s++; /* all that, just for this */ } *d++ = *s++; @@ -518,8 +593,6 @@ static I32 sublex_start() { register I32 op_type = yylval.ival; - SV *sv; - STRLEN len; if (op_type == OP_NULL) { yylval.opval = lex_op; @@ -539,19 +612,21 @@ sublex_start() SAVEINT(lex_casemods); SAVEINT(lex_starts); SAVEINT(lex_state); - SAVEINT(lex_inpat); + SAVESPTR(lex_inpat); SAVEINT(lex_inwhat); SAVEINT(curcop->cop_line); - SAVESPTR(bufptr); - SAVESPTR(oldbufptr); - SAVESPTR(oldoldbufptr); + SAVEPPTR(bufptr); + SAVEPPTR(oldbufptr); + SAVEPPTR(oldoldbufptr); + SAVEPPTR(linestart); SAVESPTR(linestr); - SAVESPTR(lex_brackstack); + SAVEPPTR(lex_brackstack); + SAVEPPTR(lex_casestack); linestr = lex_stuff; lex_stuff = Nullsv; - bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr); + bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr); bufend += SvCUR(linestr); SAVEFREESV(linestr); @@ -559,15 +634,18 @@ sublex_start() lex_brackets = 0; lex_fakebrack = 0; New(899, lex_brackstack, 120, char); + New(899, lex_casestack, 12, char); SAVEFREEPV(lex_brackstack); + SAVEFREEPV(lex_casestack); lex_casemods = 0; + *lex_casestack = '\0'; lex_starts = 0; lex_state = LEX_INTERPCONCAT; curcop->cop_line = multi_start; lex_inwhat = op_type; if (op_type == OP_MATCH || op_type == OP_SUBST) - lex_inpat = op_type; + lex_inpat = lex_op; else lex_inpat = 0; @@ -600,13 +678,14 @@ sublex_done() if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) { linestr = lex_repl; lex_inpat = 0; - bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr); + bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr); bufend += SvCUR(linestr); SAVEFREESV(linestr); lex_dojoin = FALSE; lex_brackets = 0; lex_fakebrack = 0; lex_casemods = 0; + *lex_casestack = '\0'; lex_starts = 0; if (SvCOMPILED(lex_repl)) { lex_state = LEX_INTERPNORMAL; @@ -634,12 +713,11 @@ char *start; SV *sv = NEWSV(93, send - start); register char *s = start; register char *d = SvPVX(sv); - char delim = SvIVX(linestr); bool dorange = FALSE; I32 len; char *leave = lex_inpat - ? "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}" + ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#" : (lex_inwhat & OP_TRANS) ? "" : ""; @@ -653,8 +731,8 @@ char *start; SvGROW(sv, SvLEN(sv) + 256); d = SvPVX(sv) + i; d -= 2; - max = d[1] & 0377; - for (i = (*d & 0377); i <= max; i++) + max = (U8)d[1]; + for (i = (U8)*d; i <= max; i++) *d++ = i; dorange = FALSE; continue; @@ -664,32 +742,39 @@ char *start; s++; } } - else if (*s == '@') + else if (*s == '(' && lex_inpat && s[1] == '?' && s[2] == '#') { + while (s < send && *s != ')') + *d++ = *s++; + } + else if (*s == '#' && lex_inpat && + ((PMOP*)lex_inpat)->op_pmflags & PMf_EXTENDED) { + while (s+1 < send && *s != '\n') + *d++ = *s++; + } + else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1]))) break; else if (*s == '$') { if (!lex_inpat) /* not a regexp, so $ must be var */ break; - if (s + 1 < send && s[1] != ')' && s[1] != '|') + if (s + 1 < send && !strchr(")| \n\t", s[1])) break; /* in regexp, $ might be tail anchor */ } if (*s == '\\' && s+1 < send) { s++; - if (*s == delim) { - *d++ = *s++; - continue; - } if (*s && strchr(leave, *s)) { *d++ = '\\'; *d++ = *s++; continue; } if (lex_inwhat == OP_SUBST && !lex_inpat && - isDIGIT(*s) && !isDIGIT(s[1])) + isDIGIT(*s) && *s != '0' && !isDIGIT(s[1])) { + if (dowarn) + warn("\\%c better written as $%c", *s, *s); *--s = '$'; break; } - if (lex_inwhat != OP_TRANS && *s && strchr("lLuUE", *s)) { + if (lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) { --s; break; } @@ -716,7 +801,7 @@ char *start; s++; *d = *s++; if (isLOWER(*d)) - *d = toupper(*d); + *d = toUPPER(*d); *d++ ^= 64; continue; case 'b': @@ -828,7 +913,7 @@ register char *s; weight -= seen[un_char] * 10; if (isALNUM(s[1])) { scan_ident(s,send,tmpbuf,FALSE); - if (strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE)) + if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV)) weight -= 100; else weight -= 10; @@ -891,7 +976,211 @@ register char *s; return TRUE; } -static char* exp_name[] = { "OPERATOR", "TERM", "REF", "STATE", "BLOCK" }; +static int +intuit_method(start,gv) +char *start; +GV *gv; +{ + char *s = start + (*start == '$'); + char tmpbuf[1024]; + STRLEN len; + GV* indirgv; + + if (gv) { + if (GvIO(gv)) + return 0; + if (!GvCV(gv)) + gv = 0; + } + s = scan_word(s, tmpbuf, TRUE, &len); + if (*start == '$') { + if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf)) + return 0; + s = skipspace(s); + bufptr = start; + expect = XREF; + return *s == '(' ? FUNCMETH : METHOD; + } + if (!keyword(tmpbuf, len)) { + indirgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVCV); + if (indirgv && GvCV(indirgv)) + return 0; + /* filehandle or package name makes it a method */ + if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) { + s = skipspace(s); + nextval[nexttoke].opval = + (OP*)newSVOP(OP_CONST, 0, + newSVpv(tmpbuf,0)); + nextval[nexttoke].opval->op_private = + OPpCONST_BARE; + expect = XTERM; + force_next(WORD); + bufptr = s; + return *s == '(' ? FUNCMETH : METHOD; + } + } + return 0; +} + +static char* +incl_perldb() +{ + if (perldb) { + char *pdb = getenv("PERL5DB"); + + if (pdb) + return pdb; + return "BEGIN { require 'perl5db.pl' }"; + } + return ""; +} + + +/* Encoded script support. filter_add() effectively inserts a + * 'pre-processing' function into the current source input stream. + * Note that the filter function only applies to the current source file + * (e.g., it will not affect files 'require'd or 'use'd by this one). + * + * The datasv parameter (which may be NULL) can be used to pass + * private data to this instance of the filter. The filter function + * can recover the SV using the FILTER_DATA macro and use it to + * store private buffers and state information. + * + * The supplied datasv parameter is upgraded to a PVIO type + * and the IoDIRP field is used to store the function pointer. + * 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(funcp, datasv) + filter_t funcp; + SV *datasv; +{ + if (!funcp){ /* temporary handy debugging hack to be deleted */ + filter_debug = atoi((char*)datasv); + return NULL; + } + if (!rsfp_filters) + rsfp_filters = newAV(); + if (!datasv) + datasv = newSV(0); + 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) + warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na)); + av_unshift(rsfp_filters, 1); + av_store(rsfp_filters, 0, datasv) ; + return(datasv); +} + + +/* Delete most recently added instance of this filter function. */ +void +filter_del(funcp) + filter_t funcp; +{ + if (filter_debug) + warn("filter_del func %lx", funcp); + if (!rsfp_filters || AvFILL(rsfp_filters)<0) + return; + /* if filter is on top of stack (usual case) just pop it off */ + if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){ + /* sv_free(av_pop(rsfp_filters)); */ + sv_free(av_shift(rsfp_filters)); + + return; + } + /* we need to search for the correct entry and clear it */ + die("filter_del can only delete in reverse order (currently)"); +} + + +/* Invoke the n'th filter function for the current rsfp. */ +I32 +filter_read(idx, buf_sv, maxlen) + int idx; + SV *buf_sv; + int maxlen; /* 0 = read one text line */ +{ + filter_t funcp; + SV *datasv = NULL; + + if (!rsfp_filters) + return -1; + if (idx > AvFILL(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) + warn("filter_read %d: from rsfp\n", idx); + if (maxlen) { + /* Want a block */ + int len ; + int old_len = SvCUR(buf_sv) ; + + /* ensure buf_sv is large enough */ + SvGROW(buf_sv, old_len + maxlen) ; + if ((len = PerlIO_read(rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){ + if (PerlIO_error(rsfp)) + return -1; /* error */ + else + return 0 ; /* end of file */ + } + SvCUR_set(buf_sv, old_len + len) ; + } else { + /* Want a line */ + if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) { + if (PerlIO_error(rsfp)) + return -1; /* error */ + else + return 0 ; /* end of file */ + } + } + return SvCUR(buf_sv); + } + /* Skip this filter slot if filter has been deleted */ + if ( (datasv = FILTER_DATA(idx)) == &sv_undef){ + if (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) + warn("filter_read %d: via function %lx (%s)\n", + idx, funcp, SvPV(datasv,na)); + /* Call function. The function is expected to */ + /* call "FILTER_READ(idx+1, buf_sv)" first. */ + /* Return: <0:error, =0:eof, >0:not eof */ + return (*funcp)(idx, buf_sv, maxlen); +} + +static char * +filter_gets(sv,fp, append) +register SV *sv; +register PerlIO *fp; +STRLEN append; +{ + if (rsfp_filters) { + + SvCUR_set(sv, 0); /* start with empty line */ + if (FILTER_READ(0, sv, 0) > 0) + return ( SvPVX(sv) ) ; + else + return Nullch ; + } + else + return (sv_gets(sv, fp, append)); + +} + + +#ifdef DEBUGGING + static char* exp_name[] = + { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" }; +#endif extern int yychar; /* last token */ @@ -916,6 +1205,7 @@ yylex() if (!nexttoke) { lex_state = lex_defer; expect = lex_expect; + lex_defer = LEX_NORMAL; } return(nexttype[nexttoke]); @@ -925,26 +1215,40 @@ yylex() croak("panic: INTERPCASEMOD"); #endif if (bufptr == bufend || bufptr[1] == 'E') { - if (lex_casemods <= 1) { - if (bufptr != bufend) - bufptr += 2; - lex_state = LEX_INTERPSTART; - } + char oldmod; if (lex_casemods) { - --lex_casemods; + oldmod = lex_casestack[--lex_casemods]; + lex_casestack[lex_casemods] = '\0'; + if (bufptr != bufend && strchr("LUQ", oldmod)) { + bufptr += 2; + lex_state = LEX_INTERPCONCAT; + } return ')'; } + if (bufptr != bufend) + bufptr += 2; + lex_state = LEX_INTERPCONCAT; return yylex(); } - else if (lex_casemods) { - --lex_casemods; - return ')'; - } else { s = bufptr + 1; if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3)) tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */ - ++lex_casemods; + if (strchr("LU", *s) && + (strchr(lex_casestack, 'L') || strchr(lex_casestack, 'U'))) + { + lex_casestack[--lex_casemods] = '\0'; + return ')'; + } + if (lex_casemods > 10) { + char* newlb = Renew(lex_casestack, lex_casemods + 2, char); + if (newlb != lex_casestack) { + SAVEFREEPV(newlb); + lex_casestack = newlb; + } + } + lex_casestack[lex_casemods++] = *s; + lex_casestack[lex_casemods] = '\0'; lex_state = LEX_INTERPCONCAT; nextval[nexttoke].ival = 0; force_next('('); @@ -956,6 +1260,8 @@ yylex() nextval[nexttoke].ival = OP_LC; else if (*s == 'U') nextval[nexttoke].ival = OP_UC; + else if (*s == 'Q') + nextval[nexttoke].ival = OP_QUOTEMETA; else croak("panic: yylex"); bufptr = s + 1; @@ -978,7 +1284,7 @@ yylex() if (lex_dojoin) { nextval[nexttoke].ival = 0; force_next(','); - force_ident("\""); + force_ident("\"", '$'); nextval[nexttoke].ival = 0; force_next('$'); nextval[nexttoke].ival = 0; @@ -1044,35 +1350,25 @@ yylex() } return yylex(); + case LEX_FORMLINE: + lex_state = LEX_NORMAL; + s = scan_formline(bufptr); + if (!lex_formbrack) + goto rightbracket; + OPERATOR(';'); } s = bufptr; oldoldbufptr = oldbufptr; oldbufptr = s; DEBUG_p( { - fprintf(stderr,"### Tokener expecting %s at %s\n", exp_name[expect], s); + PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[expect], s); } ) retry: -#ifdef BADSWITCH - if (*s & 128) { - if ((*s & 127) == '}') { - *s++ = '}'; - TOKEN('}'); - } - else - warn("Unrecognized character \\%03o ignored", *s++ & 255); - goto retry; - } -#endif switch (*s) { default: - if ((*s & 127) == '}') { - *s++ = '}'; - TOKEN('}'); - } - else - warn("Unrecognized character \\%03o ignored", *s++ & 255); + warn("Unrecognized character \\%03o ignored", *s++ & 255); goto retry; case 4: case 26: @@ -1087,18 +1383,25 @@ yylex() goto retry; /* ignore stray nulls */ last_uni = 0; last_lop = 0; - if (!preambled) { + if (!in_eval && !preambled) { preambled = TRUE; - sv_setpv(linestr,""); - if (perldb) { - char *pdb = getenv("PERLDB"); - - sv_catpv(linestr, pdb ? pdb : "BEGIN { require 'perldb.pl' }"); + sv_setpv(linestr,incl_perldb()); + if (SvCUR(linestr)) + sv_catpv(linestr,";"); + if (preambleav){ + while(AvFILL(preambleav) >= 0) { + SV *tmpsv = av_shift(preambleav); + sv_catsv(linestr, tmpsv); + sv_catpv(linestr, ";"); + sv_free(tmpsv); + } + sv_free((SV*)preambleav); + preambleav = NULL; } if (minus_n || minus_p) { sv_catpv(linestr, "LINE: while (<>) {"); if (minus_l) - sv_catpv(linestr,"chop;"); + sv_catpv(linestr,"chomp;"); if (minus_a){ if (minus_F){ char tmpbuf1[50]; @@ -1114,42 +1417,57 @@ yylex() sv_catpv(linestr,"@F=split(' ');"); } } - oldoldbufptr = oldbufptr = s = SvPVX(linestr); + sv_catpv(linestr, "\n"); + oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); bufend = SvPVX(linestr) + SvCUR(linestr); + if (perldb && curstash != debstash) { + SV *sv = NEWSV(85,0); + + sv_upgrade(sv, SVt_PVMG); + sv_setsv(sv,linestr); + av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv); + } goto retry; } -#ifdef CRYPTSCRIPT - cryptswitch(); -#endif /* CRYPTSCRIPT */ do { - if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) { + if ((s = filter_gets(linestr, rsfp, 0)) == Nullch) { fake_eof: if (rsfp) { - if (preprocess) + if (preprocess && !in_eval) (void)my_pclose(rsfp); - else if ((FILE*)rsfp == stdin) - clearerr(stdin); + else if ((PerlIO *)rsfp == PerlIO_stdin()) + PerlIO_clearerr(rsfp); else - (void)fclose(rsfp); + (void)PerlIO_close(rsfp); rsfp = Nullfp; } - if (minus_n || minus_p) { + if (!in_eval && (minus_n || minus_p)) { sv_setpv(linestr,minus_p ? ";}continue{print" : ""); sv_catpv(linestr,";}"); - oldoldbufptr = oldbufptr = s = SvPVX(linestr); + oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); bufend = SvPVX(linestr) + SvCUR(linestr); minus_n = minus_p = 0; goto retry; } - oldoldbufptr = oldbufptr = s = SvPVX(linestr); + oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); sv_setpv(linestr,""); TOKEN(';'); /* not infinite loop because rsfp is NULL now */ } - if (doextract && *s == '#') - doextract = FALSE; + if (doextract) { + if (*s == '#' && s[1] == '!' && instr(s,"perl")) + doextract = FALSE; + + /* Incest with pod. */ + if (*s == '=' && strnEQ(s, "=cut", 4)) { + sv_setpv(linestr, ""); + oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); + doextract = FALSE; + } + } incline(s); } while (doextract); - oldoldbufptr = oldbufptr = bufptr = s; + oldoldbufptr = oldbufptr = bufptr = linestart = s; if (perldb && curstash != debstash) { SV *sv = NEWSV(85,0); @@ -1161,11 +1479,17 @@ yylex() if (curcop->cop_line == 1) { while (s < bufend && isSPACE(*s)) s++; - if (*s == ':') /* for csh's that have to exec sh scripts */ + if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */ s++; - if (*s == '#' && s[1] == '!') { - if (!in_eval && !instr(s,"perl") && !instr(s,"indir") && - instr(origargv[0],"perl")) { + if (!in_eval && *s == '#' && s[1] == '!') { + d = instr(s,"perl -"); + if (!d) + d = instr(s,"perl"); + if (!d && + !minus_c && + !instr(s,"indir") && + instr(origargv[0],"perl")) + { char **newargv; char *cmd; @@ -1192,18 +1516,37 @@ yylex() execv(cmd,newargv); croak("Can't exec %s", cmd); } - if (d = instr(s, "perl -")) { - d += 6; - /*SUPPRESS 530*/ - while (d = moreswitches(d)) ; + if (d) { + int oldpdb = perldb; + int oldn = minus_n; + int oldp = minus_p; + + while (*d && !isSPACE(*d)) d++; + while (*d == ' ' || *d == '\t') d++; + + if (*d++ == '-') { + while (d = moreswitches(d)) ; + if (perldb && !oldpdb || + ( minus_n || minus_p ) && !(oldn || oldp) ) + /* if we have already added "LINE: while (<>) {", + we must not do it again */ + { + sv_setpv(linestr, ""); + oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr); + bufend = SvPVX(linestr) + SvCUR(linestr); + preambled = FALSE; + if (perldb) + (void)gv_fetchfile(origfilename); + goto retry; + } + } } } } - if (in_format && lex_brackets <= 1) { - s = scan_formline(s); - if (!in_format) - goto rightbracket; - OPERATOR(';'); + if (lex_formbrack && lex_brackets <= lex_formbrack) { + bufptr = s; + lex_state = LEX_FORMLINE; + return yylex(); } goto retry; case ' ': case '\t': case '\f': case '\r': case 013: @@ -1218,11 +1561,10 @@ yylex() if (s < d) s++; incline(s); - if (in_format && lex_brackets <= 1) { - s = scan_formline(s); - if (!in_format) - goto rightbracket; - OPERATOR(';'); + if (lex_formbrack && lex_brackets <= lex_formbrack) { + bufptr = s; + lex_state = LEX_FORMLINE; + return yylex(); } } else { @@ -1233,8 +1575,22 @@ yylex() case '-': if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) { s++; + bufptr = s; + tmp = *s++; + + while (s < bufend && (*s == ' ' || *s == '\t')) + s++; + + if (strnEQ(s,"=>",2)) { + if (dowarn) + warn("Ambiguous use of -%c => resolved to \"-%c\" =>", + tmp, tmp); + s = force_word(bufptr,WORD,FALSE,FALSE,FALSE); + OPERATOR('-'); /* unary minus */ + } last_uni = oldbufptr; - switch (*s++) { + last_lop_op = OP_FTEREAD; /* good enough */ + switch (tmp) { case 'r': FTST(OP_FTEREAD); case 'w': FTST(OP_FTEWRITE); case 'x': FTST(OP_FTEEXEC); @@ -1259,11 +1615,11 @@ yylex() case 't': FTST(OP_FTTTY); case 'T': FTST(OP_FTTEXT); case 'B': FTST(OP_FTBINARY); - case 'M': gv_fetchpv("\024",TRUE); FTST(OP_FTMTIME); - case 'A': gv_fetchpv("\024",TRUE); FTST(OP_FTATIME); - case 'C': gv_fetchpv("\024",TRUE); FTST(OP_FTCTIME); + case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME); + case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME); + case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME); default: - s -= 2; + croak("Unrecognized file test: -%c", tmp); break; } } @@ -1279,11 +1635,13 @@ yylex() s++; s = skipspace(s); if (isIDFIRST(*s)) { - s = force_word(s,METHOD,FALSE,TRUE); + s = force_word(s,METHOD,FALSE,TRUE,FALSE); TOKEN(ARROW); } + else if (*s == '$') + OPERATOR(ARROW); else - PREBLOCK(ARROW); + TERM(ARROW); } if (expect == XOPERATOR) Aop(OP_SUBTRACT); @@ -1314,7 +1672,9 @@ yylex() if (expect != XOPERATOR) { s = scan_ident(s, bufend, tokenbuf, TRUE); expect = XOPERATOR; - force_ident(tokenbuf); + force_ident(tokenbuf, '*'); + if (!*tokenbuf) + PREREF('*'); TERM('*'); } s++; @@ -1332,7 +1692,7 @@ yylex() tokenbuf[0] = '%'; if (in_my) { if (strchr(tokenbuf,':')) - croak("\"my\" variable %s can't be in a package",tokenbuf); + croak(no_myglob,tokenbuf); nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf); force_next(PRIVATEREF); @@ -1346,7 +1706,7 @@ yylex() TERM('%'); } } - force_ident(tokenbuf + 1); + force_ident(tokenbuf + 1, *tokenbuf); } else PREREF('%'); @@ -1357,20 +1717,28 @@ yylex() case '^': s++; - BOop(OP_XOR); + BOop(OP_BIT_XOR); case '[': lex_brackets++; /* FALL THROUGH */ case '~': case ',': - case ':': tmp = *s++; OPERATOR(tmp); + case ':': + if (s[1] == ':') { + len = 0; + goto just_a_word; + } + s++; + OPERATOR(':'); case '(': s++; - if (last_lop == oldoldbufptr) + if (last_lop == oldoldbufptr || last_uni == oldoldbufptr) oldbufptr = oldoldbufptr; /* allow print(STDOUT 123) */ - OPERATOR('('); + else + expect = XTERM; + TOKEN('('); case ';': if (curcop->cop_line < copline) copline = curcop->cop_line; @@ -1378,6 +1746,9 @@ yylex() OPERATOR(tmp); case ')': tmp = *s++; + s = skipspace(s); + if (*s == '{') + PREBLOCK(tmp); TERM(tmp); case ']': s++; @@ -1387,50 +1758,89 @@ yylex() --lex_brackets; if (lex_state == LEX_INTERPNORMAL) { if (lex_brackets == 0) { - if (*s != '-' || s[1] != '>') + if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>')) lex_state = LEX_INTERPEND; } } - TOKEN(']'); + TERM(']'); case '{': leftbracket: - if (in_format == 2) - in_format = 0; s++; if (lex_brackets > 100) { - char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1); + char* newlb = Renew(lex_brackstack, lex_brackets + 1, char); if (newlb != lex_brackstack) { SAVEFREEPV(newlb); lex_brackstack = newlb; } } - if (oldoldbufptr == last_lop) - lex_brackstack[lex_brackets++] = XTERM; - else - lex_brackstack[lex_brackets++] = XOPERATOR; - if (expect == XTERM) + switch (expect) { + case XTERM: + if (lex_formbrack) { + s--; + PRETERMBLOCK(DO); + } + if (oldoldbufptr == last_lop) + lex_brackstack[lex_brackets++] = XTERM; + else + lex_brackstack[lex_brackets++] = XOPERATOR; OPERATOR(HASHBRACK); - else if (expect == XBLOCK || expect == XOPERATOR) { - lex_brackstack[lex_brackets-1] = XSTATE; + break; + case XOPERATOR: + while (s < bufend && (*s == ' ' || *s == '\t')) + s++; + if (s < bufend && (isALPHA(*s) || *s == '_')) { + d = scan_word(s, tokenbuf, FALSE, &len); + while (d < bufend && (*d == ' ' || *d == '\t')) + d++; + if (*d == '}') { + if (dowarn && + (keyword(tokenbuf, len) || + perl_get_cv(tokenbuf, FALSE) )) + warn("Ambiguous use of {%s} resolved to {\"%s\"}", + tokenbuf, tokenbuf); + s = force_word(s,WORD,FALSE,TRUE,FALSE); + } + } + /* FALL THROUGH */ + case XBLOCK: + lex_brackstack[lex_brackets++] = XSTATE; expect = XSTATE; - } - else { - char *t; - s = skipspace(s); - if (*s == '}') - OPERATOR(HASHBRACK); - for (t = s; - t < bufend && - (isSPACE(*t) || isALPHA(*t) || *t == '"' || *t == '\''); - t++) ; - if (*t == ',' || (*t == '=' && t[1] == '>')) - OPERATOR(HASHBRACK); - if (expect == XREF) - expect = XTERM; - else { - lex_brackstack[lex_brackets-1] = XSTATE; - expect = XSTATE; + break; + case XTERMBLOCK: + lex_brackstack[lex_brackets++] = XOPERATOR; + expect = XSTATE; + break; + default: { + char *t; + if (oldoldbufptr == last_lop) + lex_brackstack[lex_brackets++] = XTERM; + else + lex_brackstack[lex_brackets++] = XOPERATOR; + s = skipspace(s); + if (*s == '}') + OPERATOR(HASHBRACK); + if (isALPHA(*s)) { + for (t = s; t < bufend && isALNUM(*t); t++) ; + } + else if (*s == '\'' || *s == '"') { + t = strchr(s+1,*s); + if (!t++) + t = s; + } + else + t = s; + while (t < bufend && isSPACE(*t)) + t++; + if ((*t == ',' && !isLOWER(*s)) || (*t == '=' && t[1] == '>')) + OPERATOR(HASHBRACK); + if (expect == XREF) + expect = XTERM; + else { + lex_brackstack[lex_brackets-1] = XSTATE; + expect = XSTATE; + } } + break; } yylval.ival = curcop->cop_line; if (isSPACE(*s) || *s == '#') @@ -1443,6 +1853,8 @@ yylex() yyerror("Unmatched right bracket"); else expect = (expectation)lex_brackstack[--lex_brackets]; + if (lex_brackets < lex_formbrack) + lex_formbrack = 0; if (lex_state == LEX_INTERPNORMAL) { if (lex_brackets == 0) { if (lex_fakebrack) { @@ -1450,20 +1862,25 @@ yylex() bufptr = s; return yylex(); /* ignore fake brackets */ } - if (*s != '-' || s[1] != '>') + if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>')) lex_state = LEX_INTERPEND; } } + if (lex_brackets < lex_fakebrack) { + bufptr = s; + lex_fakebrack = 0; + return yylex(); /* ignore fake brackets */ + } force_next('}'); TOKEN(';'); case '&': s++; tmp = *s++; if (tmp == '&') - OPERATOR(ANDAND); + AOPERATOR(ANDAND); s--; if (expect == XOPERATOR) { - if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) { + if (dowarn && isALPHA(*s) && bufptr == linestart) { curcop->cop_line--; warn(warn_nosemi); curcop->cop_line++; @@ -1474,17 +1891,18 @@ yylex() s = scan_ident(s-1, bufend, tokenbuf, TRUE); if (*tokenbuf) { expect = XOPERATOR; - force_ident(tokenbuf); + force_ident(tokenbuf, '&'); } else PREREF('&'); + yylval.ival = (OPpENTERSUB_AMPER<<8); TERM('&'); case '|': s++; tmp = *s++; if (tmp == '|') - OPERATOR(OROR); + AOPERATOR(OROR); s--; BOop(OP_BIT_OR); case '=': @@ -1499,13 +1917,42 @@ yylex() if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp)) warn("Reversed %c= operator",tmp); s--; - if (in_format == 2 && (tmp == '\n' || s[1] == '\n')) { - in_format = 1; - s--; - expect = XBLOCK; - goto leftbracket; + if (expect == XSTATE && isALPHA(tmp) && + (s == linestart+1 || s[-2] == '\n') ) + { + if (in_eval && !rsfp) { + d = bufend; + while (s < d) { + if (*s++ == '\n') { + incline(s); + if (strnEQ(s,"=cut",4)) { + s = strchr(s,'\n'); + if (s) + s++; + else + s = d; + incline(s); + goto retry; + } + } + } + goto retry; + } + s = bufend; + doextract = TRUE; + goto retry; + } + if (lex_brackets < lex_formbrack) { + char *t; + for (t = s; *t == ' ' || *t == '\t'; t++) ; + if (*t == '\n' || *t == '#') { + s--; + expect = XBLOCK; + goto leftbracket; + } } - OPERATOR('='); + yylval.ival = 0; + OPERATOR(ASSIGNOP); case '!': s++; tmp = *s++; @@ -1549,42 +1996,82 @@ yylex() Rop(OP_GT); case '$': - if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_' || s[2] == '{')) { - s = scan_ident(s+1, bufend, tokenbuf, FALSE); + if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) { + s = scan_ident(s+1, bufend, tokenbuf+1, FALSE); if (expect == XOPERATOR) { - if (in_format) - OPERATOR(','); /* grandfather non-comma-format format */ + if (lex_formbrack && lex_brackets == lex_formbrack) { + expect = XTERM; + depcom(); + return ','; /* grandfather non-comma-format format */ + } else no_op("Array length",s); } + else if (!tokenbuf[1]) + PREREF(DOLSHARP); + if (!strchr(tokenbuf+1,':')) { + tokenbuf[0] = '@'; + if (tmp = pad_findmy(tokenbuf)) { + nextval[nexttoke].opval = newOP(OP_PADANY, 0); + nextval[nexttoke].opval->op_targ = tmp; + expect = XOPERATOR; + force_next(PRIVATEREF); + TOKEN(DOLSHARP); + } + } expect = XOPERATOR; - force_ident(tokenbuf); + force_ident(tokenbuf+1, *tokenbuf); TOKEN(DOLSHARP); } s = scan_ident(s, bufend, tokenbuf+1, FALSE); if (expect == XOPERATOR) { - if (in_format) - OPERATOR(','); /* grandfather non-comma-format format */ + if (lex_formbrack && lex_brackets == lex_formbrack) { + expect = XTERM; + depcom(); + return ','; /* grandfather non-comma-format format */ + } else no_op("Scalar",s); } if (tokenbuf[1]) { + expectation oldexpect = expect; + + /* This kludge not intended to be bulletproof. */ + if (tokenbuf[1] == '[' && !tokenbuf[2]) { + yylval.opval = newSVOP(OP_CONST, 0, + newSViv((IV)compiling.cop_arybase)); + yylval.opval->op_private = OPpCONST_ARYBASE; + TERM(THING); + } tokenbuf[0] = '$'; - if (dowarn && *s == '[') { + if (dowarn) { char *t; - for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ; - if (*t++ == ',') { - bufptr = skipspace(bufptr); - while (t < bufend && *t != ']') t++; - warn("Multidimensional syntax %.*s not supported", - t-bufptr+1, bufptr); + if (*s == '[' && oldexpect != XREF) { + for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ; + if (*t++ == ',') { + bufptr = skipspace(bufptr); + while (t < bufend && *t != ']') t++; + warn("Multidimensional syntax %.*s not supported", + t-bufptr+1, bufptr); + } + } + if (*s == '{' && strEQ(tokenbuf, "$SIG") && + (t = strchr(s,'}')) && (t = strchr(t,'='))) { + char tmpbuf[1024]; + STRLEN len; + for (t++; isSPACE(*t); t++) ; + if (isIDFIRST(*t)) { + t = scan_word(t, tmpbuf, TRUE, &len); + if (*t != '(' && perl_get_cv(tmpbuf, FALSE)) + warn("You need to quote \"%s\"", tmpbuf); + } } } expect = XOPERATOR; if (lex_state == LEX_NORMAL && isSPACE(*s)) { bool islop = (last_lop == oldoldbufptr); s = skipspace(s); - if (!islop) + if (!islop || last_lop_op == OP_GREPSTART) expect = XOPERATOR; else if (strchr("$@\"'`q", *s)) expect = XTERM; /* e.g. print $fh "foo" */ @@ -1601,26 +2088,44 @@ yylex() } if (in_my) { if (strchr(tokenbuf,':')) - croak("\"my\" variable %s can't be in a package",tokenbuf); + croak(no_myglob,tokenbuf); nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf); force_next(PRIVATEREF); } else if (!strchr(tokenbuf,':')) { - if (*s == '[') - tokenbuf[0] = '@'; - else if (*s == '{') - tokenbuf[0] = '%'; + if (oldexpect != XREF || oldoldbufptr == last_lop) { + if (intuit_more(s)) { + if (*s == '[') + tokenbuf[0] = '@'; + else if (*s == '{') + tokenbuf[0] = '%'; + } + } if (tmp = pad_findmy(tokenbuf)) { + if (last_lop_op == OP_SORT && + !tokenbuf[2] && *tokenbuf =='$' && + tokenbuf[1] <= 'b' && tokenbuf[1] >= 'a') + { + for (d = in_eval ? oldoldbufptr : linestart; + d < bufend && *d != '\n'; + d++) + { + if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) { + croak("Can't use \"my %s\" in sort comparison", + tokenbuf); + } + } + } nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = tmp; force_next(PRIVATEREF); } else - force_ident(tokenbuf+1); + force_ident(tokenbuf+1, *tokenbuf); } else - force_ident(tokenbuf+1); + force_ident(tokenbuf+1, *tokenbuf); } else { if (s == bufend) @@ -1634,19 +2139,23 @@ yylex() if (expect == XOPERATOR) no_op("Array",s); if (tokenbuf[1]) { + GV* gv; + tokenbuf[0] = '@'; expect = XOPERATOR; if (in_my) { if (strchr(tokenbuf,':')) - croak("\"my\" variable %s can't be in a package",tokenbuf); + croak(no_myglob,tokenbuf); nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf); force_next(PRIVATEREF); TERM('@'); } else if (!strchr(tokenbuf,':')) { - if (*s == '{') - tokenbuf[0] = '%'; + if (intuit_more(s)) { + if (*s == '{') + tokenbuf[0] = '%'; + } if (tmp = pad_findmy(tokenbuf)) { nextval[nexttoke].opval = newOP(OP_PADANY, 0); nextval[nexttoke].opval->op_targ = tmp; @@ -1654,17 +2163,34 @@ yylex() TERM('@'); } } - if (dowarn && *s == '[') { - char *t; - for (t = s+1; *t && (isALNUM(*t) || strchr(" \t$#+-", *t)); t++) - ; - if (*t++ == ']') { - bufptr = skipspace(bufptr); - warn("Scalar value %.*s better written as $%.*s", - t-bufptr, bufptr, t-bufptr-1, bufptr+1); + + /* Force them to make up their mind on "@foo". */ + if (lex_state != LEX_NORMAL && !lex_brackets && + ( !(gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV)) || + (*tokenbuf == '@' + ? !GvAV(gv) + : !GvHV(gv) ))) + { + char tmpbuf[1024]; + sprintf(tmpbuf, "Literal @%s now requires backslash",tokenbuf+1); + yyerror(tmpbuf); + } + + /* Warn about @ where they meant $. */ + if (dowarn) { + if (*s == '[' || *s == '{') { + char *t = s + 1; + while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t))) + t++; + if (*t == '}' || *t == ']') { + t++; + bufptr = skipspace(bufptr); + warn("Scalar value %.*s better written as $%.*s", + t-bufptr, bufptr, t-bufptr-1, bufptr+1); + } } } - force_ident(tokenbuf+1); + force_ident(tokenbuf+1, *tokenbuf); } else { if (s == bufend) @@ -1686,8 +2212,9 @@ yylex() OPERATOR(tmp); case '.': - if (in_format == 2) { - in_format = 0; + if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' && + (s == linestart || s[-1] == '\n') ) { + lex_formbrack = 0; expect = XSTATE; goto rightbracket; } @@ -1718,27 +2245,39 @@ yylex() case '\'': s = scan_str(s); if (expect == XOPERATOR) { - if (in_format) - OPERATOR(','); /* grandfather non-comma-format format */ + if (lex_formbrack && lex_brackets == lex_formbrack) { + expect = XTERM; + depcom(); + return ','; /* grandfather non-comma-format format */ + } else no_op("String",s); } if (!s) - missingterm(0); + missingterm((char*)0); yylval.ival = OP_CONST; TERM(sublex_start()); case '"': s = scan_str(s); if (expect == XOPERATOR) { - if (in_format) - OPERATOR(','); /* grandfather non-comma-format format */ + if (lex_formbrack && lex_brackets == lex_formbrack) { + expect = XTERM; + depcom(); + return ','; /* grandfather non-comma-format format */ + } else no_op("String",s); } if (!s) - missingterm(0); - yylval.ival = OP_SCALAR; + missingterm((char*)0); + yylval.ival = OP_CONST; + for (d = SvPV(lex_stuff, len); len; len--, d++) { + if (*d == '$' || *d == '@' || *d == '\\') { + yylval.ival = OP_STRINGIFY; + break; + } + } TERM(sublex_start()); case '`': @@ -1746,13 +2285,15 @@ yylex() if (expect == XOPERATOR) no_op("Backticks",s); if (!s) - missingterm(0); + missingterm((char*)0); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); case '\\': s++; + if (dowarn && lex_inwhat && isDIGIT(*s)) + warn("Can't use \\%c to mean $%c in expression", *s, *s); if (expect == XOPERATOR) no_op("Backslash",s); OPERATOR(REFGEN); @@ -1793,33 +2334,70 @@ yylex() case 'z': case 'Z': keylookup: - d = s; + bufptr = s; s = scan_word(s, tokenbuf, FALSE, &len); - switch (tmp = keyword(tokenbuf, len)) { + if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE")) + goto just_a_word; + + 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))) + warn("Ambiguous use of %s => resolved to \"%s\" =>", + tokenbuf, tokenbuf); + yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); + yylval.opval->op_private = OPpCONST_BARE; + TERM(WORD); + } + + if (tmp < 0) { /* second-class keyword? */ + GV* gv; + if (expect != XOPERATOR && + (*s != ':' || s[1] != ':') && + (gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) && + GvIMPORTED_CV(gv)) + { + tmp = 0; + } + else + tmp = -tmp; + } + + reserved_word: + switch (tmp) { default: /* not a keyword */ just_a_word: { GV *gv; + char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]); /* Get the rest if it looks like a package qualifier */ - if (*s == '\'' || *s == ':') + if (*s == '\'' || *s == ':' && s[1] == ':') { s = scan_word(s, tokenbuf + len, TRUE, &len); + if (!len) + 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 = savestr(tokenbuf); + yylval.pval = savepv(tokenbuf); s++; CLINE; TOKEN(LABEL); } } - else if (dowarn && expect == XOPERATOR) { - if (bufptr == SvPVX(linestr)) { + else if (expect == XOPERATOR) { + if (bufptr == linestart) { curcop->cop_line--; warn(warn_nosemi); curcop->cop_line++; @@ -1830,23 +2408,41 @@ yylex() /* Look for a subroutine with this name in current package. */ - gv = gv_fetchpv(tokenbuf,FALSE); + gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV); + + /* Presume this is going to be a bareword of some sort. */ + + CLINE; + yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); + yylval.opval->op_private = OPpCONST_BARE; /* See if it's the indirect object for a list operator. */ - if (oldoldbufptr && oldoldbufptr < bufptr) { - if (oldoldbufptr == last_lop && - (!gv || !GvCV(gv) || last_lop_op == OP_SORT)) - { - expect = XTERM; - CLINE; - yylval.opval = (OP*)newSVOP(OP_CONST, 0, - newSVpv(tokenbuf,0)); - yylval.opval->op_private = OPpCONST_BARE; - for (d = tokenbuf; *d && isLOWER(*d); d++) ; - if (dowarn && !*d) - warn(warn_reserved, tokenbuf); - TOKEN(WORD); + if (oldoldbufptr && + oldoldbufptr < bufptr && + (oldoldbufptr == last_lop || oldoldbufptr == last_uni) && + /* NO SKIPSPACE BEFORE HERE! */ + (expect == XREF || + (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) ) + { + bool immediate_paren = *s == '('; + + /* (Now we can afford to cross potential line boundary.) */ + s = skipspace(s); + + /* Two barewords in a row may indicate method call. */ + + if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv))) + return tmp; + + /* If not a declared subroutine, it's an indirect object. */ + /* (But it's an indir obj regardless for sort.) */ + + if ((last_lop_op == OP_SORT || + (!immediate_paren && (!gv || !GvCV(gv))) ) && + (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){ + expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR; + goto bareword; } } @@ -1856,18 +2452,14 @@ yylex() s = skipspace(s); if (*s == '(') { CLINE; - nextval[nexttoke].opval = - (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); - nextval[nexttoke].opval->op_private = OPpCONST_BARE; + nextval[nexttoke].opval = yylval.opval; expect = XOPERATOR; force_next(WORD); + yylval.ival = 0; TOKEN('&'); } - CLINE; - yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0)); - yylval.opval->op_private = OPpCONST_BARE; - /* If followed by var or block, call it a method (maybe). */ + /* If followed by var or block, call it a method (unless sub) */ if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) { last_lop = oldbufptr; @@ -1877,51 +2469,88 @@ yylex() /* If followed by a bareword, see if it looks like indir obj. */ - if (isALPHA(*s)) { - char *olds = s; - char tmpbuf[1024]; - GV* indirgv; - s = scan_word(s, tmpbuf, TRUE, &len); - if (!keyword(tmpbuf, len)) { - SV* tmpsv = newSVpv(tmpbuf,0); - indirgv = gv_fetchpv(tmpbuf,FALSE); - if (!indirgv || !GvCV(indirgv)) { - if (!gv || !GvCV(gv) || fetch_stash(tmpsv, FALSE)) { - nextval[nexttoke].opval = - (OP*)newSVOP(OP_CONST, 0, tmpsv); - nextval[nexttoke].opval->op_private = - OPpCONST_BARE; - expect = XTERM; - force_next(WORD); - TOKEN(METHOD); - } - } - SvREFCNT_dec(tmpsv); - } - s = olds; - } + if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv))) + return tmp; /* Not a method, so call it a subroutine (if defined) */ if (gv && GvCV(gv)) { - nextval[nexttoke].opval = yylval.opval; + CV* cv = GvCV(gv); if (*s == '(') { + nextval[nexttoke].opval = yylval.opval; expect = XTERM; force_next(WORD); + yylval.ival = 0; TOKEN('&'); } + if (lastchar == '-') + warn("Ambiguous use of -%s resolved as -&%s()", + tokenbuf, tokenbuf); last_lop = oldbufptr; - last_lop_op = OP_ENTERSUBR; + last_lop_op = OP_ENTERSUB; + /* Check for a constant sub */ + { + SV *sv = cv_const_sv(cv); + if (sv) { + SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv); + ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv); + yylval.opval->op_private = 0; + TOKEN(WORD); + } + } + + /* Resolve to GV now. */ + op_free(yylval.opval); + yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv)); + /* Is there a prototype? */ + if (SvPOK(cv)) { + STRLEN len; + char *proto = SvPV((SV*)cv, len); + if (!len) + TERM(FUNC0SUB); + if (strEQ(proto, "$")) + OPERATOR(UNIOPSUB); + if (*proto == '&' && *s == '{') { + sv_setpv(subname,"__ANON__"); + PREBLOCK(LSTOPSUB); + } + } + nextval[nexttoke].opval = yylval.opval; expect = XTERM; force_next(WORD); TOKEN(NOAMP); } + if (hints & HINT_STRICT_SUBS && + lastchar != '-' && + strnNE(s,"->",2) && + last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */ + last_lop_op != OP_ACCEPT && + last_lop_op != OP_PIPE_OP && + last_lop_op != OP_SOCKPAIR) + { + warn( + "Bareword \"%s\" not allowed while \"strict subs\" in use", + tokenbuf); + ++error_count; + } + /* Call it a bare word */ - for (d = tokenbuf; *d && isLOWER(*d); d++) ; - if (dowarn && !*d) - warn(warn_reserved, tokenbuf); + bareword: + if (dowarn) { + if (lastchar != '-') { + for (d = tokenbuf; *d && isLOWER(*d); d++) ; + if (!*d) + warn(warn_reserved, tokenbuf); + } + } + if (lastchar && strchr("*%&", lastchar)) { + warn("Operator or semicolon missing before %c%s", + lastchar, tokenbuf); + warn("Ambiguous use of %c resolved as operator %c", + lastchar, lastchar); + } TOKEN(WORD); } @@ -1935,26 +2564,36 @@ yylex() TERM(THING); } + case KEY___DATA__: case KEY___END__: { GV *gv; - int fd; /*SUPPRESS 560*/ - if (!in_eval && (gv = gv_fetchpv("DATA",FALSE))) { - SvMULTI_on(gv); + if (rsfp && (!in_eval || tokenbuf[2] == 'D')) { + char dname[256]; + char *pname = "main"; + if (tokenbuf[2] == 'D') + pname = HvNAME(curstash ? curstash : defstash); + sprintf(dname,"%s::DATA", pname); + gv = gv_fetchpv(dname,TRUE, SVt_PVIO); + GvMULTI_on(gv); if (!GvIO(gv)) - GvIO(gv) = newIO(); - IoIFP(GvIO(gv)) = rsfp; -#if defined(HAS_FCNTL) && defined(FFt_SETFD) - fd = fileno(rsfp); - fcntl(fd,FFt_SETFD,fd >= 3); + GvIOp(gv) = newIO(); + IoIFP(GvIOp(gv)) = rsfp; +#if defined(HAS_FCNTL) && defined(F_SETFD) + { + int fd = PerlIO_fileno(rsfp); + fcntl(fd,F_SETFD,fd >= 3); + } #endif + /* Mark this internal pseudo-handle as clean */ + IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT; if (preprocess) - IoTYPE(GvIO(gv)) = '|'; - else if ((FILE*)rsfp == stdin) - IoTYPE(GvIO(gv)) = '-'; + IoTYPE(GvIOp(gv)) = '|'; + else if ((PerlIO*)rsfp == PerlIO_stdin()) + IoTYPE(GvIOp(gv)) = '-'; else - IoTYPE(GvIO(gv)) = '<'; + IoTYPE(GvIOp(gv)) = '<'; rsfp = Nullfp; } goto fake_eof; @@ -1964,13 +2603,24 @@ yylex() case KEY_DESTROY: case KEY_BEGIN: case KEY_END: - s = skipspace(s); - if (expect == XSTATE && (minus_p || minus_n || *s == '{' )) { + if (expect == XSTATE) { s = bufptr; goto really_sub; } goto just_a_word; + case KEY_CORE: + if (*s == ':' && s[1] == ':') { + s += 2; + d = s; + s = scan_word(s, tokenbuf, FALSE, &len); + tmp = keyword(tokenbuf, len); + if (tmp < 0) + tmp = -tmp; + goto reserved_word; + } + goto just_a_word; + case KEY_abs: UNI(OP_ABS); @@ -1978,22 +2628,22 @@ yylex() UNI(OP_ALARM); case KEY_accept: - LOP(OP_ACCEPT); + LOP(OP_ACCEPT,XTERM); case KEY_and: OPERATOR(ANDOP); case KEY_atan2: - LOP(OP_ATAN2); + LOP(OP_ATAN2,XTERM); case KEY_bind: - LOP(OP_BIND); + LOP(OP_BIND,XTERM); case KEY_binmode: UNI(OP_BINMODE); case KEY_bless: - LOP(OP_BLESS); + LOP(OP_BLESS,XTERM); case KEY_chop: UNI(OP_CHOP); @@ -2002,7 +2652,7 @@ yylex() PREBLOCK(CONTINUE); case KEY_chdir: - (void)gv_fetchpv("ENV",TRUE); /* may use HOME */ + (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */ UNI(OP_CHDIR); case KEY_close: @@ -2022,19 +2672,21 @@ yylex() if (!cryptseen++) init_des(); #endif - LOP(OP_CRYPT); + LOP(OP_CRYPT,XTERM); case KEY_chmod: - s = skipspace(s); - if (dowarn && *s != '0' && isDIGIT(*s)) - yywarn("chmod: mode argument is missing initial 0"); - LOP(OP_CHMOD); + if (dowarn) { + for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ; + if (*d != '0' && isDIGIT(*d)) + yywarn("chmod: mode argument is missing initial 0"); + } + LOP(OP_CHMOD,XTERM); case KEY_chown: - LOP(OP_CHOWN); + LOP(OP_CHOWN,XTERM); case KEY_connect: - LOP(OP_CONNECT); + LOP(OP_CONNECT,XTERM); case KEY_chr: UNI(OP_CHR); @@ -2048,28 +2700,30 @@ yylex() case KEY_do: s = skipspace(s); if (*s == '{') - PREBLOCK(DO); + PRETERMBLOCK(DO); if (*s != '\'') - s = force_word(s,WORD,FALSE,TRUE); + s = force_word(s,WORD,FALSE,TRUE,FALSE); OPERATOR(DO); case KEY_die: - LOP(OP_DIE); + hints |= HINT_BLOCK_SCOPE; + LOP(OP_DIE,XTERM); case KEY_defined: UNI(OP_DEFINED); case KEY_delete: - OPERATOR(DELETE); + UNI(OP_DELETE); case KEY_dbmopen: - LOP(OP_DBMOPEN); + gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV); + LOP(OP_DBMOPEN,XTERM); case KEY_dbmclose: UNI(OP_DBMCLOSE); case KEY_dump: - s = force_word(s,WORD,TRUE,FALSE); + s = force_word(s,WORD,TRUE,FALSE,FALSE); LOOPX(OP_DUMP); case KEY_else: @@ -2082,12 +2736,15 @@ yylex() case KEY_eq: Eop(OP_SEQ); + case KEY_exists: + UNI(OP_EXISTS); + case KEY_exit: UNI(OP_EXIT); case KEY_eval: s = skipspace(s); - expect = (*s == '{') ? XBLOCK : XTERM; + expect = (*s == '{') ? XTERMBLOCK : XTERM; UNIBRACK(OP_ENTEREVAL); case KEY_eof: @@ -2101,7 +2758,7 @@ yylex() case KEY_exec: set_csh(); - LOP(OP_EXEC); + LOP(OP_EXEC,XREF); case KEY_endhostent: FUN0(OP_EHOSTENT); @@ -2131,19 +2788,19 @@ yylex() OPERATOR(FOR); case KEY_formline: - LOP(OP_FORMLINE); + LOP(OP_FORMLINE,XTERM); case KEY_fork: FUN0(OP_FORK); case KEY_fcntl: - LOP(OP_FCNTL); + LOP(OP_FCNTL,XTERM); case KEY_fileno: UNI(OP_FILENO); case KEY_flock: - LOP(OP_FLOCK); + LOP(OP_FLOCK,XTERM); case KEY_gt: Rop(OP_SGT); @@ -2152,10 +2809,10 @@ yylex() Rop(OP_SGE); case KEY_grep: - LOP(OP_GREPSTART); + LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF); case KEY_goto: - s = force_word(s,WORD,TRUE,FALSE); + s = force_word(s,WORD,TRUE,FALSE,FALSE); LOOPX(OP_GOTO); case KEY_gmtime: @@ -2171,13 +2828,13 @@ yylex() UNI(OP_GETPGRP); case KEY_getpriority: - LOP(OP_GETPRIORITY); + LOP(OP_GETPRIORITY,XTERM); case KEY_getprotobyname: UNI(OP_GPBYNAME); case KEY_getprotobynumber: - LOP(OP_GPBYNUMBER); + LOP(OP_GPBYNUMBER,XTERM); case KEY_getprotoent: FUN0(OP_GPROTOENT); @@ -2198,7 +2855,7 @@ yylex() UNI(OP_GHBYNAME); case KEY_gethostbyaddr: - LOP(OP_GHBYADDR); + LOP(OP_GHBYADDR,XTERM); case KEY_gethostent: FUN0(OP_GHOSTENT); @@ -2207,16 +2864,16 @@ yylex() UNI(OP_GNBYNAME); case KEY_getnetbyaddr: - LOP(OP_GNBYADDR); + LOP(OP_GNBYADDR,XTERM); case KEY_getnetent: FUN0(OP_GNETENT); case KEY_getservbyname: - LOP(OP_GSBYNAME); + LOP(OP_GSBYNAME,XTERM); case KEY_getservbyport: - LOP(OP_GSBYPORT); + LOP(OP_GSBYPORT,XTERM); case KEY_getservent: FUN0(OP_GSERVENT); @@ -2225,7 +2882,7 @@ yylex() UNI(OP_GETSOCKNAME); case KEY_getsockopt: - LOP(OP_GSOCKOPT); + LOP(OP_GSOCKOPT,XTERM); case KEY_getgrent: FUN0(OP_GGRENT); @@ -2240,7 +2897,8 @@ yylex() FUN0(OP_GETLOGIN); case KEY_glob: - UNI(OP_GLOB); + set_csh(); + LOP(OP_GLOB,XTERM); case KEY_hex: UNI(OP_HEX); @@ -2250,27 +2908,27 @@ yylex() OPERATOR(IF); case KEY_index: - LOP(OP_INDEX); + LOP(OP_INDEX,XTERM); case KEY_int: UNI(OP_INT); case KEY_ioctl: - LOP(OP_IOCTL); + LOP(OP_IOCTL,XTERM); case KEY_join: - LOP(OP_JOIN); + LOP(OP_JOIN,XTERM); case KEY_keys: UNI(OP_KEYS); case KEY_kill: - LOP(OP_KILL); + LOP(OP_KILL,XTERM); case KEY_last: - s = force_word(s,WORD,TRUE,FALSE); + s = force_word(s,WORD,TRUE,FALSE,FALSE); LOOPX(OP_LAST); - + case KEY_lc: UNI(OP_LC); @@ -2297,10 +2955,10 @@ yylex() UNI(OP_LOG); case KEY_link: - LOP(OP_LINK); + LOP(OP_LINK,XTERM); case KEY_listen: - LOP(OP_LISTEN); + LOP(OP_LISTEN,XTERM); case KEY_lstat: UNI(OP_LSTAT); @@ -2309,20 +2967,23 @@ yylex() s = scan_pat(s); TERM(sublex_start()); + case KEY_map: + LOP(OP_MAPSTART,XREF); + case KEY_mkdir: - LOP(OP_MKDIR); + LOP(OP_MKDIR,XTERM); case KEY_msgctl: - LOP(OP_MSGCTL); + LOP(OP_MSGCTL,XTERM); case KEY_msgget: - LOP(OP_MSGGET); + LOP(OP_MSGGET,XTERM); case KEY_msgrcv: - LOP(OP_MSGRCV); + LOP(OP_MSGRCV,XTERM); case KEY_msgsnd: - LOP(OP_MSGSND); + LOP(OP_MSGSND,XTERM); case KEY_my: in_my = TRUE; @@ -2330,12 +2991,23 @@ yylex() OPERATOR(LOCAL); case KEY_next: - s = force_word(s,WORD,TRUE,FALSE); + s = force_word(s,WORD,TRUE,FALSE,FALSE); LOOPX(OP_NEXT); case KEY_ne: Eop(OP_SNE); + case KEY_no: + if (expect != XSTATE) + yyerror("\"no\" not allowed in expression"); + s = force_word(s,WORD,FALSE,TRUE,FALSE); + s = force_version(s); + yylval.ival = 0; + OPERATOR(USE); + + case KEY_not: + OPERATOR(NOTOP); + case KEY_open: s = skipspace(s); if (isIDFIRST(*s)) { @@ -2346,9 +3018,10 @@ yylex() warn("Precedence problem: open %.*s should be open(%.*s)", d-s,s, d-s,s); } - LOP(OP_OPEN); + LOP(OP_OPEN,XTERM); case KEY_or: + yylval.ival = OP_OR; OPERATOR(OROP); case KEY_ord: @@ -2358,43 +3031,52 @@ yylex() UNI(OP_OCT); case KEY_opendir: - LOP(OP_OPEN_DIR); + LOP(OP_OPEN_DIR,XTERM); case KEY_print: checkcomma(s,tokenbuf,"filehandle"); - LOP(OP_PRINT); + LOP(OP_PRINT,XREF); case KEY_printf: checkcomma(s,tokenbuf,"filehandle"); - LOP(OP_PRTF); + LOP(OP_PRTF,XREF); + + case KEY_prototype: + UNI(OP_PROTOTYPE); case KEY_push: - LOP(OP_PUSH); + LOP(OP_PUSH,XTERM); case KEY_pop: UNI(OP_POP); + case KEY_pos: + UNI(OP_POS); + case KEY_pack: - LOP(OP_PACK); + LOP(OP_PACK,XTERM); case KEY_package: - s = force_word(s,WORD,FALSE,TRUE); + s = force_word(s,WORD,FALSE,TRUE,FALSE); OPERATOR(PACKAGE); case KEY_pipe: - LOP(OP_PIPE_OP); + LOP(OP_PIPE_OP,XTERM); case KEY_q: s = scan_str(s); if (!s) - missingterm(0); + missingterm((char*)0); yylval.ival = OP_CONST; TERM(sublex_start()); + case KEY_quotemeta: + UNI(OP_QUOTEMETA); + case KEY_qw: s = scan_str(s); if (!s) - missingterm(0); + missingterm((char*)0); force_next(')'); nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff)); lex_stuff = Nullsv; @@ -2403,13 +3085,19 @@ yylex() nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1)); force_next(THING); force_next('('); - LOP(OP_SPLIT); + yylval.ival = OP_SPLIT; + CLINE; + expect = XTERM; + bufptr = s; + last_lop = oldbufptr; + last_lop_op = OP_SPLIT; + return FUNC; case KEY_qq: s = scan_str(s); if (!s) - missingterm(0); - yylval.ival = OP_SCALAR; + missingterm((char*)0); + yylval.ival = OP_STRINGIFY; if (SvIVX(lex_stuff) == '\'') SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */ TERM(sublex_start()); @@ -2417,7 +3105,7 @@ yylex() case KEY_qx: s = scan_str(s); if (!s) - missingterm(0); + missingterm((char*)0); yylval.ival = OP_BACKTICK; set_csh(); TERM(sublex_start()); @@ -2426,18 +3114,23 @@ yylex() OLDLOP(OP_RETURN); case KEY_require: - s = force_word(s,WORD,TRUE,FALSE); + *tokenbuf = '\0'; + s = force_word(s,WORD,TRUE,TRUE,FALSE); + if (isIDFIRST(*tokenbuf)) + gv_stashpvn(tokenbuf, strlen(tokenbuf), TRUE); + else if (*s == '<') + yyerror("<> should be quotes"); UNI(OP_REQUIRE); case KEY_reset: UNI(OP_RESET); case KEY_redo: - s = force_word(s,WORD,TRUE,FALSE); + s = force_word(s,WORD,TRUE,FALSE,FALSE); LOOPX(OP_REDO); case KEY_rename: - LOP(OP_RENAME); + LOP(OP_RENAME,XTERM); case KEY_rand: UNI(OP_RAND); @@ -2446,10 +3139,10 @@ yylex() UNI(OP_RMDIR); case KEY_rindex: - LOP(OP_RINDEX); + LOP(OP_RINDEX,XTERM); case KEY_read: - LOP(OP_READ); + LOP(OP_READ,XTERM); case KEY_readdir: UNI(OP_READDIR); @@ -2466,10 +3159,10 @@ yylex() UNI(OP_REWINDDIR); case KEY_recv: - LOP(OP_RECV); + LOP(OP_RECV,XTERM); case KEY_reverse: - LOP(OP_REVERSE); + LOP(OP_REVERSE,XTERM); case KEY_readlink: UNI(OP_READLINK); @@ -2484,32 +3177,35 @@ yylex() else TOKEN(1); /* force error */ + case KEY_chomp: + UNI(OP_CHOMP); + case KEY_scalar: UNI(OP_SCALAR); case KEY_select: - LOP(OP_SELECT); + LOP(OP_SELECT,XTERM); case KEY_seek: - LOP(OP_SEEK); + LOP(OP_SEEK,XTERM); case KEY_semctl: - LOP(OP_SEMCTL); + LOP(OP_SEMCTL,XTERM); case KEY_semget: - LOP(OP_SEMGET); + LOP(OP_SEMGET,XTERM); case KEY_semop: - LOP(OP_SEMOP); + LOP(OP_SEMOP,XTERM); case KEY_send: - LOP(OP_SEND); + LOP(OP_SEND,XTERM); case KEY_setpgrp: - LOP(OP_SETPGRP); + LOP(OP_SETPGRP,XTERM); case KEY_setpriority: - LOP(OP_SETPRIORITY); + LOP(OP_SETPRIORITY,XTERM); case KEY_sethostent: FUN1(OP_SHOSTENT); @@ -2530,28 +3226,28 @@ yylex() FUN0(OP_SGRENT); case KEY_seekdir: - LOP(OP_SEEKDIR); + LOP(OP_SEEKDIR,XTERM); case KEY_setsockopt: - LOP(OP_SSOCKOPT); + LOP(OP_SSOCKOPT,XTERM); case KEY_shift: UNI(OP_SHIFT); case KEY_shmctl: - LOP(OP_SHMCTL); + LOP(OP_SHMCTL,XTERM); case KEY_shmget: - LOP(OP_SHMGET); + LOP(OP_SHMGET,XTERM); case KEY_shmread: - LOP(OP_SHMREAD); + LOP(OP_SHMREAD,XTERM); case KEY_shmwrite: - LOP(OP_SHMWRITE); + LOP(OP_SHMWRITE,XTERM); case KEY_shutdown: - LOP(OP_SHUTDOWN); + LOP(OP_SHUTDOWN,XTERM); case KEY_sin: UNI(OP_SIN); @@ -2560,10 +3256,10 @@ yylex() UNI(OP_SLEEP); case KEY_socket: - LOP(OP_SOCKET); + LOP(OP_SOCKET,XTERM); case KEY_socketpair: - LOP(OP_SOCKPAIR); + LOP(OP_SOCKPAIR,XTERM); case KEY_sort: checkcomma(s,tokenbuf,"subroutine name"); @@ -2571,17 +3267,17 @@ yylex() if (*s == ';' || *s == ')') /* probably a close */ croak("sort is now a reserved word"); expect = XTERM; - s = force_word(s,WORD,TRUE,TRUE); - LOP(OP_SORT); + s = force_word(s,WORD,TRUE,TRUE,TRUE); + LOP(OP_SORT,XREF); case KEY_split: - LOP(OP_SPLIT); + LOP(OP_SPLIT,XTERM); case KEY_sprintf: - LOP(OP_SPRINTF); + LOP(OP_SPRINTF,XTERM); case KEY_splice: - LOP(OP_SPLICE); + LOP(OP_SPLICE,XTERM); case KEY_sqrt: UNI(OP_SQRT); @@ -2597,19 +3293,16 @@ yylex() UNI(OP_STUDY); case KEY_substr: - LOP(OP_SUBSTR); + LOP(OP_SUBSTR,XTERM); case KEY_format: case KEY_sub: really_sub: - yylval.ival = start_subparse(); s = skipspace(s); - if (tmp == KEY_format) - expect = XTERM; - else - expect = XBLOCK; + if (isIDFIRST(*s) || *s == '\'' || *s == ':') { char tmpbuf[128]; + expect = XBLOCK; d = scan_word(s, tmpbuf, TRUE, &len); if (strchr(tmpbuf, ':')) sv_setpv(subname, tmpbuf); @@ -2618,33 +3311,67 @@ yylex() sv_catpvn(subname,"::",2); sv_catpvn(subname,tmpbuf,len); } - s = force_word(s,WORD,FALSE,TRUE); + s = force_word(s,WORD,FALSE,TRUE,TRUE); + s = skipspace(s); } - else + else { + expect = XTERMBLOCK; sv_setpv(subname,"?"); + } + + if (tmp == KEY_format) { + s = skipspace(s); + if (*s == '=') + lex_formbrack = lex_brackets + 1; + OPERATOR(FORMAT); + } - if (tmp != KEY_format) - PREBLOCK(SUB); + /* Look for a prototype */ + if (*s == '(') { + s = scan_str(s); + if (!s) { + if (lex_stuff) + SvREFCNT_dec(lex_stuff); + lex_stuff = Nullsv; + croak("Prototype not terminated"); + } + nexttoke++; + nextval[1] = nextval[0]; + nexttype[1] = nexttype[0]; + nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff); + nexttype[0] = THING; + if (nexttoke == 1) { + lex_defer = lex_state; + lex_expect = expect; + lex_state = LEX_KNOWNEXT; + } + lex_stuff = Nullsv; + } - in_format = 2; - lex_brackets = 0; - OPERATOR(FORMAT); + if (*SvPV(subname,na) == '?') { + sv_setpv(subname,"__ANON__"); + TOKEN(ANONSUB); + } + PREBLOCK(SUB); case KEY_system: set_csh(); - LOP(OP_SYSTEM); + LOP(OP_SYSTEM,XREF); case KEY_symlink: - LOP(OP_SYMLINK); + LOP(OP_SYMLINK,XTERM); case KEY_syscall: - LOP(OP_SYSCALL); + LOP(OP_SYSCALL,XTERM); + + case KEY_sysopen: + LOP(OP_SYSOPEN,XTERM); case KEY_sysread: - LOP(OP_SYSREAD); + LOP(OP_SYSREAD,XTERM); case KEY_syswrite: - LOP(OP_SYSWRITE); + LOP(OP_SYSWRITE,XTERM); case KEY_tr: s = scan_trans(s); @@ -2657,7 +3384,10 @@ yylex() UNI(OP_TELLDIR); case KEY_tie: - LOP(OP_TIE); + LOP(OP_TIE,XTERM); + + case KEY_tied: + UNI(OP_TIED); case KEY_time: FUN0(OP_TIME); @@ -2666,7 +3396,7 @@ yylex() FUN0(OP_TMS); case KEY_truncate: - LOP(OP_TRUNCATE); + LOP(OP_TRUNCATE,XTERM); case KEY_uc: UNI(OP_UC); @@ -2686,50 +3416,72 @@ yylex() OPERATOR(UNLESS); case KEY_unlink: - LOP(OP_UNLINK); + LOP(OP_UNLINK,XTERM); case KEY_undef: UNI(OP_UNDEF); case KEY_unpack: - LOP(OP_UNPACK); + LOP(OP_UNPACK,XTERM); case KEY_utime: - LOP(OP_UTIME); + LOP(OP_UTIME,XTERM); case KEY_umask: - s = skipspace(s); - if (dowarn && *s != '0' && isDIGIT(*s)) - warn("umask: argument is missing initial 0"); + if (dowarn) { + for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ; + if (*d != '0' && isDIGIT(*d)) + yywarn("umask: argument is missing initial 0"); + } UNI(OP_UMASK); case KEY_unshift: - LOP(OP_UNSHIFT); + LOP(OP_UNSHIFT,XTERM); + + case KEY_use: + if (expect != XSTATE) + yyerror("\"use\" not allowed in expression"); + s = skipspace(s); + if(isDIGIT(*s)) { + s = force_version(s); + if(*s == ';' || (s = skipspace(s), *s == ';')) { + nextval[nexttoke].opval = Nullop; + force_next(WORD); + } + } + else { + s = force_word(s,WORD,FALSE,TRUE,FALSE); + s = force_version(s); + } + yylval.ival = 1; + OPERATOR(USE); case KEY_values: UNI(OP_VALUES); case KEY_vec: sawvec = TRUE; - LOP(OP_VEC); + LOP(OP_VEC,XTERM); case KEY_while: yylval.ival = curcop->cop_line; OPERATOR(WHILE); case KEY_warn: - LOP(OP_WARN); + hints |= HINT_BLOCK_SCOPE; + LOP(OP_WARN,XTERM); case KEY_wait: FUN0(OP_WAIT); case KEY_waitpid: - LOP(OP_WAITPID); + LOP(OP_WAITPID,XTERM); case KEY_wantarray: FUN0(OP_WANTARRAY); case KEY_write: + gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */ UNI(OP_ENTERWRITE); case KEY_x: @@ -2738,6 +3490,10 @@ yylex() check_uni(); goto just_a_word; + case KEY_xor: + yylval.ival = OP_XOR; + OPERATOR(OROP); + case KEY_y: s = scan_trans(s); TERM(sublex_start()); @@ -2753,8 +3509,9 @@ I32 len; switch (*d) { case '_': if (d[1] == '_') { - if (strEQ(d,"__LINE__")) return KEY___LINE__; - if (strEQ(d,"__FILE__")) return KEY___FILE__; + if (strEQ(d,"__LINE__")) return -KEY___LINE__; + if (strEQ(d,"__FILE__")) return -KEY___FILE__; + if (strEQ(d,"__DATA__")) return KEY___DATA__; if (strEQ(d,"__END__")) return KEY___END__; } break; @@ -2764,15 +3521,15 @@ I32 len; case 'a': switch (len) { case 3: - if (strEQ(d,"and")) return KEY_and; - if (strEQ(d,"abs")) return KEY_abs; + if (strEQ(d,"and")) return -KEY_and; + if (strEQ(d,"abs")) return -KEY_abs; break; case 5: - if (strEQ(d,"alarm")) return KEY_alarm; - if (strEQ(d,"atan2")) return KEY_atan2; + if (strEQ(d,"alarm")) return -KEY_alarm; + if (strEQ(d,"atan2")) return -KEY_atan2; break; case 6: - if (strEQ(d,"accept")) return KEY_accept; + if (strEQ(d,"accept")) return -KEY_accept; break; } break; @@ -2780,37 +3537,41 @@ I32 len; if (strEQ(d,"BEGIN")) return KEY_BEGIN; break; case 'b': - if (strEQ(d,"bless")) return KEY_bless; - if (strEQ(d,"bind")) return KEY_bind; - if (strEQ(d,"binmode")) return KEY_binmode; + if (strEQ(d,"bless")) return -KEY_bless; + if (strEQ(d,"bind")) return -KEY_bind; + if (strEQ(d,"binmode")) return -KEY_binmode; + break; + case 'C': + if (strEQ(d,"CORE")) return -KEY_CORE; break; case 'c': switch (len) { case 3: - if (strEQ(d,"cmp")) return KEY_cmp; - if (strEQ(d,"chr")) return KEY_chr; - if (strEQ(d,"cos")) return KEY_cos; + if (strEQ(d,"cmp")) return -KEY_cmp; + if (strEQ(d,"chr")) return -KEY_chr; + if (strEQ(d,"cos")) return -KEY_cos; break; case 4: if (strEQ(d,"chop")) return KEY_chop; break; case 5: - if (strEQ(d,"close")) return KEY_close; - if (strEQ(d,"chdir")) return KEY_chdir; - if (strEQ(d,"chmod")) return KEY_chmod; - if (strEQ(d,"chown")) return KEY_chown; - if (strEQ(d,"crypt")) return KEY_crypt; + if (strEQ(d,"close")) return -KEY_close; + if (strEQ(d,"chdir")) return -KEY_chdir; + if (strEQ(d,"chomp")) return KEY_chomp; + if (strEQ(d,"chmod")) return -KEY_chmod; + if (strEQ(d,"chown")) return -KEY_chown; + if (strEQ(d,"crypt")) return -KEY_crypt; break; case 6: - if (strEQ(d,"chroot")) return KEY_chroot; - if (strEQ(d,"caller")) return KEY_caller; + if (strEQ(d,"chroot")) return -KEY_chroot; + if (strEQ(d,"caller")) return -KEY_caller; break; case 7: - if (strEQ(d,"connect")) return KEY_connect; + if (strEQ(d,"connect")) return -KEY_connect; break; case 8: - if (strEQ(d,"closedir")) return KEY_closedir; - if (strEQ(d,"continue")) return KEY_continue; + if (strEQ(d,"closedir")) return -KEY_closedir; + if (strEQ(d,"continue")) return -KEY_continue; break; } break; @@ -2823,59 +3584,63 @@ I32 len; if (strEQ(d,"do")) return KEY_do; break; case 3: - if (strEQ(d,"die")) return KEY_die; + if (strEQ(d,"die")) return -KEY_die; break; case 4: - if (strEQ(d,"dump")) return KEY_dump; + if (strEQ(d,"dump")) return -KEY_dump; break; case 6: if (strEQ(d,"delete")) return KEY_delete; break; case 7: if (strEQ(d,"defined")) return KEY_defined; - if (strEQ(d,"dbmopen")) return KEY_dbmopen; + if (strEQ(d,"dbmopen")) return -KEY_dbmopen; break; case 8: - if (strEQ(d,"dbmclose")) return KEY_dbmclose; + if (strEQ(d,"dbmclose")) return -KEY_dbmclose; break; } break; case 'E': - if (strEQ(d,"EQ")) return KEY_eq; + if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;} if (strEQ(d,"END")) return KEY_END; break; case 'e': switch (len) { case 2: - if (strEQ(d,"eq")) return KEY_eq; + if (strEQ(d,"eq")) return -KEY_eq; break; case 3: - if (strEQ(d,"eof")) return KEY_eof; - if (strEQ(d,"exp")) return KEY_exp; + if (strEQ(d,"eof")) return -KEY_eof; + if (strEQ(d,"exp")) return -KEY_exp; break; case 4: if (strEQ(d,"else")) return KEY_else; - if (strEQ(d,"exit")) return KEY_exit; + if (strEQ(d,"exit")) return -KEY_exit; if (strEQ(d,"eval")) return KEY_eval; - if (strEQ(d,"exec")) return KEY_exec; + if (strEQ(d,"exec")) return -KEY_exec; if (strEQ(d,"each")) return KEY_each; break; case 5: if (strEQ(d,"elsif")) return KEY_elsif; break; + case 6: + if (strEQ(d,"exists")) return KEY_exists; + if (strEQ(d,"elseif")) warn("elseif should be elsif"); + break; case 8: - if (strEQ(d,"endgrent")) return KEY_endgrent; - if (strEQ(d,"endpwent")) return KEY_endpwent; + if (strEQ(d,"endgrent")) return -KEY_endgrent; + if (strEQ(d,"endpwent")) return -KEY_endpwent; break; case 9: - if (strEQ(d,"endnetent")) return KEY_endnetent; + if (strEQ(d,"endnetent")) return -KEY_endnetent; break; case 10: - if (strEQ(d,"endhostent")) return KEY_endhostent; - if (strEQ(d,"endservent")) return KEY_endservent; + if (strEQ(d,"endhostent")) return -KEY_endhostent; + if (strEQ(d,"endservent")) return -KEY_endservent; break; case 11: - if (strEQ(d,"endprotoent")) return KEY_endprotoent; + if (strEQ(d,"endprotoent")) return -KEY_endprotoent; break; } break; @@ -2885,28 +3650,28 @@ I32 len; if (strEQ(d,"for")) return KEY_for; break; case 4: - if (strEQ(d,"fork")) return KEY_fork; + if (strEQ(d,"fork")) return -KEY_fork; break; case 5: - if (strEQ(d,"fcntl")) return KEY_fcntl; - if (strEQ(d,"flock")) return KEY_flock; + if (strEQ(d,"fcntl")) return -KEY_fcntl; + if (strEQ(d,"flock")) return -KEY_flock; break; case 6: if (strEQ(d,"format")) return KEY_format; - if (strEQ(d,"fileno")) return KEY_fileno; + if (strEQ(d,"fileno")) return -KEY_fileno; break; case 7: if (strEQ(d,"foreach")) return KEY_foreach; break; case 8: - if (strEQ(d,"formline")) return KEY_formline; + if (strEQ(d,"formline")) return -KEY_formline; break; } break; case 'G': if (len == 2) { - if (strEQ(d,"GT")) return KEY_gt; - if (strEQ(d,"GE")) return KEY_ge; + if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;} + if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;} } break; case 'g': @@ -2915,72 +3680,72 @@ I32 len; if (*d == 'p') { switch (len) { case 7: - if (strEQ(d,"ppid")) return KEY_getppid; - if (strEQ(d,"pgrp")) return KEY_getpgrp; + if (strEQ(d,"ppid")) return -KEY_getppid; + if (strEQ(d,"pgrp")) return -KEY_getpgrp; break; case 8: - if (strEQ(d,"pwent")) return KEY_getpwent; - if (strEQ(d,"pwnam")) return KEY_getpwnam; - if (strEQ(d,"pwuid")) return KEY_getpwuid; + if (strEQ(d,"pwent")) return -KEY_getpwent; + if (strEQ(d,"pwnam")) return -KEY_getpwnam; + if (strEQ(d,"pwuid")) return -KEY_getpwuid; break; case 11: - if (strEQ(d,"peername")) return KEY_getpeername; - if (strEQ(d,"protoent")) return KEY_getprotoent; - if (strEQ(d,"priority")) return KEY_getpriority; + if (strEQ(d,"peername")) return -KEY_getpeername; + if (strEQ(d,"protoent")) return -KEY_getprotoent; + if (strEQ(d,"priority")) return -KEY_getpriority; break; case 14: - if (strEQ(d,"protobyname")) return KEY_getprotobyname; + if (strEQ(d,"protobyname")) return -KEY_getprotobyname; break; case 16: - if (strEQ(d,"protobynumber"))return KEY_getprotobynumber; + if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber; break; } } else if (*d == 'h') { - if (strEQ(d,"hostbyname")) return KEY_gethostbyname; - if (strEQ(d,"hostbyaddr")) return KEY_gethostbyaddr; - if (strEQ(d,"hostent")) return KEY_gethostent; + if (strEQ(d,"hostbyname")) return -KEY_gethostbyname; + if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr; + if (strEQ(d,"hostent")) return -KEY_gethostent; } else if (*d == 'n') { - if (strEQ(d,"netbyname")) return KEY_getnetbyname; - if (strEQ(d,"netbyaddr")) return KEY_getnetbyaddr; - if (strEQ(d,"netent")) return KEY_getnetent; + if (strEQ(d,"netbyname")) return -KEY_getnetbyname; + if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr; + if (strEQ(d,"netent")) return -KEY_getnetent; } else if (*d == 's') { - if (strEQ(d,"servbyname")) return KEY_getservbyname; - if (strEQ(d,"servbyport")) return KEY_getservbyport; - if (strEQ(d,"servent")) return KEY_getservent; - if (strEQ(d,"sockname")) return KEY_getsockname; - if (strEQ(d,"sockopt")) return KEY_getsockopt; + if (strEQ(d,"servbyname")) return -KEY_getservbyname; + if (strEQ(d,"servbyport")) return -KEY_getservbyport; + if (strEQ(d,"servent")) return -KEY_getservent; + if (strEQ(d,"sockname")) return -KEY_getsockname; + if (strEQ(d,"sockopt")) return -KEY_getsockopt; } else if (*d == 'g') { - if (strEQ(d,"grent")) return KEY_getgrent; - if (strEQ(d,"grnam")) return KEY_getgrnam; - if (strEQ(d,"grgid")) return KEY_getgrgid; + if (strEQ(d,"grent")) return -KEY_getgrent; + if (strEQ(d,"grnam")) return -KEY_getgrnam; + if (strEQ(d,"grgid")) return -KEY_getgrgid; } else if (*d == 'l') { - if (strEQ(d,"login")) return KEY_getlogin; + if (strEQ(d,"login")) return -KEY_getlogin; } - else if (strEQ(d,"c")) return KEY_getc; + else if (strEQ(d,"c")) return -KEY_getc; break; } switch (len) { case 2: - if (strEQ(d,"gt")) return KEY_gt; - if (strEQ(d,"ge")) return KEY_ge; + if (strEQ(d,"gt")) return -KEY_gt; + if (strEQ(d,"ge")) return -KEY_ge; break; case 4: if (strEQ(d,"grep")) return KEY_grep; if (strEQ(d,"goto")) return KEY_goto; - if (strEQ(d,"glob")) return KEY_glob; + if (strEQ(d,"glob")) return -KEY_glob; break; case 6: - if (strEQ(d,"gmtime")) return KEY_gmtime; + if (strEQ(d,"gmtime")) return -KEY_gmtime; break; } break; case 'h': - if (strEQ(d,"hex")) return KEY_hex; + if (strEQ(d,"hex")) return -KEY_hex; break; case 'i': switch (len) { @@ -2988,56 +3753,56 @@ I32 len; if (strEQ(d,"if")) return KEY_if; break; case 3: - if (strEQ(d,"int")) return KEY_int; + if (strEQ(d,"int")) return -KEY_int; break; case 5: - if (strEQ(d,"index")) return KEY_index; - if (strEQ(d,"ioctl")) return KEY_ioctl; + if (strEQ(d,"index")) return -KEY_index; + if (strEQ(d,"ioctl")) return -KEY_ioctl; break; } break; case 'j': - if (strEQ(d,"join")) return KEY_join; + if (strEQ(d,"join")) return -KEY_join; break; case 'k': if (len == 4) { if (strEQ(d,"keys")) return KEY_keys; - if (strEQ(d,"kill")) return KEY_kill; + if (strEQ(d,"kill")) return -KEY_kill; } break; case 'L': if (len == 2) { - if (strEQ(d,"LT")) return KEY_lt; - if (strEQ(d,"LE")) return KEY_le; + if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;} + if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;} } break; case 'l': switch (len) { case 2: - if (strEQ(d,"lt")) return KEY_lt; - if (strEQ(d,"le")) return KEY_le; - if (strEQ(d,"lc")) return KEY_lc; + if (strEQ(d,"lt")) return -KEY_lt; + if (strEQ(d,"le")) return -KEY_le; + if (strEQ(d,"lc")) return -KEY_lc; break; case 3: - if (strEQ(d,"log")) return KEY_log; + if (strEQ(d,"log")) return -KEY_log; break; case 4: if (strEQ(d,"last")) return KEY_last; - if (strEQ(d,"link")) return KEY_link; + if (strEQ(d,"link")) return -KEY_link; break; case 5: if (strEQ(d,"local")) return KEY_local; - if (strEQ(d,"lstat")) return KEY_lstat; + if (strEQ(d,"lstat")) return -KEY_lstat; break; case 6: - if (strEQ(d,"length")) return KEY_length; - if (strEQ(d,"listen")) return KEY_listen; + if (strEQ(d,"length")) return -KEY_length; + if (strEQ(d,"listen")) return -KEY_listen; break; case 7: - if (strEQ(d,"lcfirst")) return KEY_lcfirst; + if (strEQ(d,"lcfirst")) return -KEY_lcfirst; break; case 9: - if (strEQ(d,"localtime")) return KEY_localtime; + if (strEQ(d,"localtime")) return -KEY_localtime; break; } break; @@ -3047,38 +3812,43 @@ I32 len; case 2: if (strEQ(d,"my")) return KEY_my; break; + case 3: + if (strEQ(d,"map")) return KEY_map; + break; case 5: - if (strEQ(d,"mkdir")) return KEY_mkdir; + if (strEQ(d,"mkdir")) return -KEY_mkdir; break; case 6: - if (strEQ(d,"msgctl")) return KEY_msgctl; - if (strEQ(d,"msgget")) return KEY_msgget; - if (strEQ(d,"msgrcv")) return KEY_msgrcv; - if (strEQ(d,"msgsnd")) return KEY_msgsnd; + if (strEQ(d,"msgctl")) return -KEY_msgctl; + if (strEQ(d,"msgget")) return -KEY_msgget; + if (strEQ(d,"msgrcv")) return -KEY_msgrcv; + if (strEQ(d,"msgsnd")) return -KEY_msgsnd; break; } break; case 'N': - if (strEQ(d,"NE")) return KEY_ne; + if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;} break; case 'n': if (strEQ(d,"next")) return KEY_next; - if (strEQ(d,"ne")) return KEY_ne; + if (strEQ(d,"ne")) return -KEY_ne; + if (strEQ(d,"not")) return -KEY_not; + if (strEQ(d,"no")) return KEY_no; break; case 'o': switch (len) { case 2: - if (strEQ(d,"or")) return KEY_or; + if (strEQ(d,"or")) return -KEY_or; break; case 3: - if (strEQ(d,"ord")) return KEY_ord; - if (strEQ(d,"oct")) return KEY_oct; + if (strEQ(d,"ord")) return -KEY_ord; + if (strEQ(d,"oct")) return -KEY_oct; break; case 4: - if (strEQ(d,"open")) return KEY_open; + if (strEQ(d,"open")) return -KEY_open; break; case 7: - if (strEQ(d,"opendir")) return KEY_opendir; + if (strEQ(d,"opendir")) return -KEY_opendir; break; } break; @@ -3086,11 +3856,12 @@ I32 len; switch (len) { case 3: if (strEQ(d,"pop")) return KEY_pop; + if (strEQ(d,"pos")) return KEY_pos; break; case 4: if (strEQ(d,"push")) return KEY_push; - if (strEQ(d,"pack")) return KEY_pack; - if (strEQ(d,"pipe")) return KEY_pipe; + if (strEQ(d,"pack")) return -KEY_pack; + if (strEQ(d,"pipe")) return -KEY_pipe; break; case 5: if (strEQ(d,"print")) return KEY_print; @@ -3101,6 +3872,8 @@ I32 len; case 7: if (strEQ(d,"package")) return KEY_package; break; + case 9: + if (strEQ(d,"prototype")) return KEY_prototype; } break; case 'q': @@ -3110,39 +3883,40 @@ I32 len; if (strEQ(d,"qw")) return KEY_qw; if (strEQ(d,"qx")) return KEY_qx; } + else if (strEQ(d,"quotemeta")) return -KEY_quotemeta; break; case 'r': switch (len) { case 3: - if (strEQ(d,"ref")) return KEY_ref; + if (strEQ(d,"ref")) return -KEY_ref; break; case 4: - if (strEQ(d,"read")) return KEY_read; - if (strEQ(d,"rand")) return KEY_rand; - if (strEQ(d,"recv")) return KEY_recv; + if (strEQ(d,"read")) return -KEY_read; + if (strEQ(d,"rand")) return -KEY_rand; + if (strEQ(d,"recv")) return -KEY_recv; if (strEQ(d,"redo")) return KEY_redo; break; case 5: - if (strEQ(d,"rmdir")) return KEY_rmdir; - if (strEQ(d,"reset")) return KEY_reset; + if (strEQ(d,"rmdir")) return -KEY_rmdir; + if (strEQ(d,"reset")) return -KEY_reset; break; case 6: if (strEQ(d,"return")) return KEY_return; - if (strEQ(d,"rename")) return KEY_rename; - if (strEQ(d,"rindex")) return KEY_rindex; + if (strEQ(d,"rename")) return -KEY_rename; + if (strEQ(d,"rindex")) return -KEY_rindex; break; case 7: - if (strEQ(d,"require")) return KEY_require; - if (strEQ(d,"reverse")) return KEY_reverse; - if (strEQ(d,"readdir")) return KEY_readdir; + if (strEQ(d,"require")) return -KEY_require; + if (strEQ(d,"reverse")) return -KEY_reverse; + if (strEQ(d,"readdir")) return -KEY_readdir; break; case 8: - if (strEQ(d,"readlink")) return KEY_readlink; - if (strEQ(d,"readline")) return KEY_readline; - if (strEQ(d,"readpipe")) return KEY_readpipe; + if (strEQ(d,"readlink")) return -KEY_readlink; + if (strEQ(d,"readline")) return -KEY_readline; + if (strEQ(d,"readpipe")) return -KEY_readpipe; break; case 9: - if (strEQ(d,"rewinddir")) return KEY_rewinddir; + if (strEQ(d,"rewinddir")) return -KEY_rewinddir; break; } break; @@ -3155,36 +3929,36 @@ I32 len; case 'e': switch (len) { case 4: - if (strEQ(d,"seek")) return KEY_seek; - if (strEQ(d,"send")) return KEY_send; + if (strEQ(d,"seek")) return -KEY_seek; + if (strEQ(d,"send")) return -KEY_send; break; case 5: - if (strEQ(d,"semop")) return KEY_semop; + if (strEQ(d,"semop")) return -KEY_semop; break; case 6: - if (strEQ(d,"select")) return KEY_select; - if (strEQ(d,"semctl")) return KEY_semctl; - if (strEQ(d,"semget")) return KEY_semget; + if (strEQ(d,"select")) return -KEY_select; + if (strEQ(d,"semctl")) return -KEY_semctl; + if (strEQ(d,"semget")) return -KEY_semget; break; case 7: - if (strEQ(d,"setpgrp")) return KEY_setpgrp; - if (strEQ(d,"seekdir")) return KEY_seekdir; + if (strEQ(d,"setpgrp")) return -KEY_setpgrp; + if (strEQ(d,"seekdir")) return -KEY_seekdir; break; case 8: - if (strEQ(d,"setpwent")) return KEY_setpwent; - if (strEQ(d,"setgrent")) return KEY_setgrent; + if (strEQ(d,"setpwent")) return -KEY_setpwent; + if (strEQ(d,"setgrent")) return -KEY_setgrent; break; case 9: - if (strEQ(d,"setnetent")) return KEY_setnetent; + if (strEQ(d,"setnetent")) return -KEY_setnetent; break; case 10: - if (strEQ(d,"setsockopt")) return KEY_setsockopt; - if (strEQ(d,"sethostent")) return KEY_sethostent; - if (strEQ(d,"setservent")) return KEY_setservent; + if (strEQ(d,"setsockopt")) return -KEY_setsockopt; + if (strEQ(d,"sethostent")) return -KEY_sethostent; + if (strEQ(d,"setservent")) return -KEY_setservent; break; case 11: - if (strEQ(d,"setpriority")) return KEY_setpriority; - if (strEQ(d,"setprotoent")) return KEY_setprotoent; + if (strEQ(d,"setpriority")) return -KEY_setpriority; + if (strEQ(d,"setprotoent")) return -KEY_setprotoent; break; } break; @@ -3194,60 +3968,61 @@ I32 len; if (strEQ(d,"shift")) return KEY_shift; break; case 6: - if (strEQ(d,"shmctl")) return KEY_shmctl; - if (strEQ(d,"shmget")) return KEY_shmget; + if (strEQ(d,"shmctl")) return -KEY_shmctl; + if (strEQ(d,"shmget")) return -KEY_shmget; break; case 7: - if (strEQ(d,"shmread")) return KEY_shmread; + if (strEQ(d,"shmread")) return -KEY_shmread; break; case 8: - if (strEQ(d,"shmwrite")) return KEY_shmwrite; - if (strEQ(d,"shutdown")) return KEY_shutdown; + if (strEQ(d,"shmwrite")) return -KEY_shmwrite; + if (strEQ(d,"shutdown")) return -KEY_shutdown; break; } break; case 'i': - if (strEQ(d,"sin")) return KEY_sin; + if (strEQ(d,"sin")) return -KEY_sin; break; case 'l': - if (strEQ(d,"sleep")) return KEY_sleep; + if (strEQ(d,"sleep")) return -KEY_sleep; break; case 'o': if (strEQ(d,"sort")) return KEY_sort; - if (strEQ(d,"socket")) return KEY_socket; - if (strEQ(d,"socketpair")) return KEY_socketpair; + if (strEQ(d,"socket")) return -KEY_socket; + if (strEQ(d,"socketpair")) return -KEY_socketpair; break; case 'p': if (strEQ(d,"split")) return KEY_split; - if (strEQ(d,"sprintf")) return KEY_sprintf; + if (strEQ(d,"sprintf")) return -KEY_sprintf; if (strEQ(d,"splice")) return KEY_splice; break; case 'q': - if (strEQ(d,"sqrt")) return KEY_sqrt; + if (strEQ(d,"sqrt")) return -KEY_sqrt; break; case 'r': - if (strEQ(d,"srand")) return KEY_srand; + if (strEQ(d,"srand")) return -KEY_srand; break; case 't': - if (strEQ(d,"stat")) return KEY_stat; + if (strEQ(d,"stat")) return -KEY_stat; if (strEQ(d,"study")) return KEY_study; break; case 'u': - if (strEQ(d,"substr")) return KEY_substr; + if (strEQ(d,"substr")) return -KEY_substr; if (strEQ(d,"sub")) return KEY_sub; break; case 'y': switch (len) { case 6: - if (strEQ(d,"system")) return KEY_system; + if (strEQ(d,"system")) return -KEY_system; break; case 7: - if (strEQ(d,"sysread")) return KEY_sysread; - if (strEQ(d,"symlink")) return KEY_symlink; - if (strEQ(d,"syscall")) return KEY_syscall; + if (strEQ(d,"sysopen")) return -KEY_sysopen; + if (strEQ(d,"sysread")) return -KEY_sysread; + if (strEQ(d,"symlink")) return -KEY_symlink; + if (strEQ(d,"syscall")) return -KEY_syscall; break; case 8: - if (strEQ(d,"syswrite")) return KEY_syswrite; + if (strEQ(d,"syswrite")) return -KEY_syswrite; break; } break; @@ -3262,67 +4037,72 @@ I32 len; if (strEQ(d,"tie")) return KEY_tie; break; case 4: - if (strEQ(d,"tell")) return KEY_tell; - if (strEQ(d,"time")) return KEY_time; + if (strEQ(d,"tell")) return -KEY_tell; + if (strEQ(d,"tied")) return KEY_tied; + if (strEQ(d,"time")) return -KEY_time; break; case 5: - if (strEQ(d,"times")) return KEY_times; + if (strEQ(d,"times")) return -KEY_times; break; case 7: - if (strEQ(d,"telldir")) return KEY_telldir; + if (strEQ(d,"telldir")) return -KEY_telldir; break; case 8: - if (strEQ(d,"truncate")) return KEY_truncate; + if (strEQ(d,"truncate")) return -KEY_truncate; break; } break; case 'u': switch (len) { case 2: - if (strEQ(d,"uc")) return KEY_uc; + if (strEQ(d,"uc")) return -KEY_uc; + break; + case 3: + if (strEQ(d,"use")) return KEY_use; break; case 5: if (strEQ(d,"undef")) return KEY_undef; if (strEQ(d,"until")) return KEY_until; if (strEQ(d,"untie")) return KEY_untie; - if (strEQ(d,"utime")) return KEY_utime; - if (strEQ(d,"umask")) return KEY_umask; + if (strEQ(d,"utime")) return -KEY_utime; + if (strEQ(d,"umask")) return -KEY_umask; break; case 6: if (strEQ(d,"unless")) return KEY_unless; - if (strEQ(d,"unpack")) return KEY_unpack; - if (strEQ(d,"unlink")) return KEY_unlink; + if (strEQ(d,"unpack")) return -KEY_unpack; + if (strEQ(d,"unlink")) return -KEY_unlink; break; case 7: if (strEQ(d,"unshift")) return KEY_unshift; - if (strEQ(d,"ucfirst")) return KEY_ucfirst; + if (strEQ(d,"ucfirst")) return -KEY_ucfirst; break; } break; case 'v': - if (strEQ(d,"values")) return KEY_values; - if (strEQ(d,"vec")) return KEY_vec; + if (strEQ(d,"values")) return -KEY_values; + if (strEQ(d,"vec")) return -KEY_vec; break; case 'w': switch (len) { case 4: - if (strEQ(d,"warn")) return KEY_warn; - if (strEQ(d,"wait")) return KEY_wait; + if (strEQ(d,"warn")) return -KEY_warn; + if (strEQ(d,"wait")) return -KEY_wait; break; case 5: if (strEQ(d,"while")) return KEY_while; - if (strEQ(d,"write")) return KEY_write; + if (strEQ(d,"write")) return -KEY_write; break; case 7: - if (strEQ(d,"waitpid")) return KEY_waitpid; + if (strEQ(d,"waitpid")) return -KEY_waitpid; break; case 9: - if (strEQ(d,"wantarray")) return KEY_wantarray; + if (strEQ(d,"wantarray")) return -KEY_wantarray; break; } break; case 'x': - if (len == 1) return KEY_x; + if (len == 1) return -KEY_x; + if (strEQ(d,"xor")) return -KEY_xor; break; case 'y': if (len == 1) return KEY_y; @@ -3342,10 +4122,16 @@ char *what; char *w; if (dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */ - w = strchr(s,')'); - if (w) - for (w++; *w && isSPACE(*w); w++) ; - if (!w || !*w || !strchr(";|}", *w)) /* an advisory hack only... */ + int level = 1; + for (w = s+2; *w && level; w++) { + if (*w == '(') + ++level; + else if (*w == ')') + --level; + } + if (*w) + for (; *w && isSPACE(*w); w++) ; + if (!*w || !strchr(";|})]oa!=", *w)) /* an advisory hack only... */ warn("%s (...) interpreted as function",name); } while (s < bufend && isSPACE(*s)) @@ -3363,7 +4149,7 @@ char *what; if (*s == ',') { int kw; *s = '\0'; - kw = keyword(w, s - w); + kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0; *s = ','; if (kw) return; @@ -3409,10 +4195,12 @@ I32 ck_uni; { register char *d; char *bracket = 0; + char funny = *s++; if (lex_brackets == 0) lex_fakebrack = 0; - s++; + if (isSPACE(*s)) + s = skipspace(s); d = dest; if (isDIGIT(*s)) { while (isDIGIT(*s)) @@ -3427,7 +4215,7 @@ I32 ck_uni; *d++ = ':'; s++; } - else if (*s == ':' && s[1] == ':' && isIDFIRST(s[2])) { + else if (*s == ':' && s[1] == ':') { *d++ = *s++; *d++ = *s++; } @@ -3442,9 +4230,9 @@ I32 ck_uni; lex_state = LEX_INTERPENDMAYBE; return s; } - if (isSPACE(*s) || - (*s == '$' && s[1] && (isALPHA(s[1]) || strchr("$_{", s[1])))) - return s; + if (*s == '$' && s[1] && + (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) ) + return s; if (*s == '{') { bracket = s; s++; @@ -3454,21 +4242,29 @@ I32 ck_uni; if (s < send) *d = *s++; d[1] = '\0'; - if (*d == '^' && (isUPPER(*s) || strchr("[\\]^_?", *s))) { + if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) { *d = *s++ ^ 64; } if (bracket) { + if (isSPACE(s[-1])) { + while (s < send && (*s == ' ' || *s == '\t')) s++; + *d = *s; + } if (isALPHA(*d) || *d == '_') { d++; - while (isALNUM(*s)) + while (isALNUM(*s) || *s == ':') *d++ = *s++; *d = '\0'; - if (*s == '[' || *s == '{') { - if (lex_brackets) - croak("Can't use delimiter brackets within expression"); - lex_fakebrack = TRUE; + while (s < send && (*s == ' ' || *s == '\t')) s++; + if ((*s == '[' || *s == '{')) { + if (dowarn && keyword(dest, d - dest)) { + char *brack = *s == '[' ? "[...]" : "{...}"; + warn("Ambiguous use of %c{%s%s} resolved to %c%s%s", + funny, dest, brack, funny, dest, brack); + } + lex_fakebrack = lex_brackets+1; bracket++; - lex_brackets++; + lex_brackstack[lex_brackets++] = XOPERATOR; return s; } } @@ -3476,6 +4272,12 @@ I32 ck_uni; s++; if (lex_state == LEX_INTERPNORMAL && !lex_brackets) lex_state = LEX_INTERPEND; + if (funny == '#') + funny = '@'; + if (dowarn && + (keyword(dest, d - dest) || perl_get_cv(dest, FALSE))) + warn("Ambiguous use of %c{%s} resolved to %c%s", + funny, dest, funny, dest); } else { s = bracket; /* let the parser handle it */ @@ -3487,89 +4289,24 @@ I32 ck_uni; return s; } -void -scan_prefix(pm,string,len) -PMOP *pm; -char *string; -I32 len; +void pmflag(pmfl,ch) +U16* pmfl; +int ch; { - register SV *tmpstr; - register char *t; - register char *d; - register char *e; - char *origstring = string; - - if (ninstr(string, string+len, vert, vert+1)) - return; - if (*string == '^') - string++, len--; - tmpstr = NEWSV(86,len); - sv_upgrade(tmpstr, SVt_PVBM); - sv_setpvn(tmpstr,string,len); - t = SvPVX(tmpstr); - e = t + len; - BmUSEFUL(tmpstr) = 100; - for (d=t; d < e; ) { - switch (*d) { - case '{': - if (isDIGIT(d[1])) - e = d; - else - goto defchar; - break; - case '.': case '[': case '$': case '(': case ')': case '|': case '+': - case '^': - e = d; - break; - case '\\': - if (d[1] && strchr("wWbB0123456789sSdDlLuUExc",d[1])) { - e = d; - break; - } - Move(d+1,d,e-d,char); - e--; - switch(*d) { - case 'n': - *d = '\n'; - break; - case 't': - *d = '\t'; - break; - case 'f': - *d = '\f'; - break; - case 'r': - *d = '\r'; - break; - case 'e': - *d = '\033'; - break; - case 'a': - *d = '\007'; - break; - } - /* FALL THROUGH */ - default: - defchar: - if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') { - e = d; - break; - } - d++; - } - } - if (d == t) { - SvREFCNT_dec(tmpstr); - return; + if (ch == 'i') { + sawi = TRUE; + *pmfl |= PMf_FOLD; } - *d = '\0'; - SvCUR_set(tmpstr, d - t); - if (d == t+len) - pm->op_pmflags |= PMf_ALL; - if (*origstring != '^') - pm->op_pmflags |= PMf_SCANFIRST; - pm->op_pmshort = tmpstr; - pm->op_pmslen = d - t; + else if (ch == 'g') + *pmfl |= PMf_GLOBAL; + else if (ch == 'o') + *pmfl |= PMf_KEEP; + else if (ch == 'm') + *pmfl |= PMf_MULTILINE; + else if (ch == 's') + *pmfl |= PMf_SINGLELINE; + else if (ch == 'x') + *pmfl |= PMf_EXTENDED; } static char * @@ -3579,8 +4316,6 @@ char *start; PMOP *pm; char *s; - multi_start = curcop->cop_line; - s = scan_str(start); if (!s) { if (lex_stuff) @@ -3589,25 +4324,13 @@ char *start; croak("Search pattern not terminated"); } pm = (PMOP*)newPMOP(OP_MATCH, 0); - if (*start == '?') + if (multi_open == '?') pm->op_pmflags |= PMf_ONCE; - while (*s == 'i' || *s == 'o' || *s == 'g') { - if (*s == 'i') { - s++; - sawi = TRUE; - pm->op_pmflags |= PMf_FOLD; - } - if (*s == 'o') { - s++; - pm->op_pmflags |= PMf_KEEP; - } - if (*s == 'g') { - s++; - pm->op_pmflags |= PMf_GLOBAL; - } - } + while (*s && strchr("iogmsx", *s)) + pmflag(&pm->op_pmflags,*s++); + pm->op_pmpermflags = pm->op_pmflags; lex_op = (OP*)pm; yylval.ival = OP_MATCH; return s; @@ -3617,14 +4340,13 @@ static char * scan_subst(start) char *start; { - register char *s = start; + register char *s; register PMOP *pm; I32 es = 0; - multi_start = curcop->cop_line; yylval.ival = OP_NULL; - s = scan_str(s); + s = scan_str(start); if (!s) { if (lex_stuff) @@ -3633,7 +4355,7 @@ char *start; croak("Substitution pattern not terminated"); } - if (s[-1] == *start) + if (s[-1] == multi_open) s--; s = scan_str(s); @@ -3648,24 +4370,13 @@ char *start; } pm = (PMOP*)newPMOP(OP_SUBST, 0); - while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') { + while (*s && strchr("iogmsex", *s)) { if (*s == 'e') { s++; es++; } - if (*s == 'g') { - s++; - pm->op_pmflags |= PMf_GLOBAL; - } - if (*s == 'i') { - s++; - sawi = TRUE; - pm->op_pmflags |= PMf_FOLD; - } - if (*s == 'o') { - s++; - pm->op_pmflags |= PMf_KEEP; - } + else + pmflag(&pm->op_pmflags,*s++); } if (es) { @@ -3673,7 +4384,7 @@ char *start; pm->op_pmflags |= PMf_EVAL; repl = newSVpv("",0); while (es-- > 0) - sv_catpvn(repl, "eval ", 5); + sv_catpv(repl, es ? "eval " : "do "); sv_catpvn(repl, "{ ", 2); sv_catsv(repl, lex_repl); sv_catpvn(repl, " };", 2); @@ -3682,6 +4393,7 @@ char *start; lex_repl = repl; } + pm->op_pmpermflags = pm->op_pmflags; lex_op = (OP*)pm; yylval.ival = OP_SUBST; return s; @@ -3699,6 +4411,7 @@ register PMOP *pm; else if (pm->op_pmflags & PMf_FOLD) return; pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart); + pm->op_pmslen = SvCUR(pm->op_pmshort); } else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */ if (pm->op_pmshort && @@ -3719,6 +4432,7 @@ register PMOP *pm; (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); pm->op_pmregexp->regmust = Nullsv; pm->op_pmflags |= PMf_SCANFIRST; } @@ -3729,7 +4443,7 @@ static char * scan_trans(start) char *start; { - register char *s = start; + register char* s; OP *op; short *tbl; I32 squash; @@ -3738,14 +4452,14 @@ char *start; yylval.ival = OP_NULL; - s = scan_str(s); + s = scan_str(start); if (!s) { if (lex_stuff) SvREFCNT_dec(lex_stuff); lex_stuff = Nullsv; croak("Translation pattern not terminated"); } - if (s[-1] == *start) + if (s[-1] == multi_open) s--; s = scan_str(s); @@ -3789,12 +4503,15 @@ register char *s; SV *tmpstr; char term; register char *d; + char *peek; s += 2; d = tokenbuf; if (!rsfp) *d++ = '\n'; - if (*s && strchr("`'\"",*s)) { + for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ; + if (*peek && strchr("`'\"",*peek)) { + s = peek; term = *s++; s = cpytill(d,s,bufend,term,&len); if (s < bufend) @@ -3806,6 +4523,8 @@ register char *s; s++, term = '\''; else term = '"'; + if (!isALNUM(*s)) + deprecate("bare << to mean <<\"\""); while (isALNUM(*s)) *d++ = *s++; } /* assuming tokenbuf won't clobber */ @@ -3818,20 +4537,26 @@ register char *s; else s--, herewas = newSVpv(s,d-s); s += SvCUR(herewas); - if (term == '\'') + + tmpstr = NEWSV(87,80); + sv_upgrade(tmpstr, SVt_PVIV); + if (term == '\'') { op_type = OP_CONST; - if (term == '`') + SvIVX(tmpstr) = -1; + } + else if (term == '`') { op_type = OP_BACKTICK; + SvIVX(tmpstr) = '\\'; + } CLINE; multi_start = curcop->cop_line; multi_open = multi_close = '<'; - tmpstr = NEWSV(87,80); term = *tokenbuf; if (!rsfp) { d = s; while (s < bufend && - (*s != term || bcmp(s,tokenbuf,len) != 0) ) { + (*s != term || memcmp(s,tokenbuf,len) != 0) ) { if (*s++ == '\n') curcop->cop_line++; } @@ -3843,14 +4568,14 @@ register char *s; s += len - 1; sv_catpvn(herewas,s,bufend-s); sv_setsv(linestr,herewas); - oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr); + oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr); bufend = SvPVX(linestr) + SvCUR(linestr); } else sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */ while (s >= bufend) { /* multiple line string? */ if (!rsfp || - !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) { + !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) { curcop->cop_line = multi_start; missingterm(tokenbuf); } @@ -3864,7 +4589,7 @@ register char *s; (I32)curcop->cop_line,sv); } bufend = SvPVX(linestr) + SvCUR(linestr); - if (*s == term && bcmp(s,tokenbuf,len) == 0) { + if (*s == term && memcmp(s,tokenbuf,len) == 0) { s = bufend - 1; *s = ' '; sv_catsv(linestr,herewas); @@ -3902,8 +4627,8 @@ char *start; else croak("Unterminated <> operator"); - if (*d == '$') d++; - while (*d && (isALNUM(*d) || *d == '\'')) + if (*d == '$' && d[1]) d++; + while (*d && (isALNUM(*d) || *d == '\'' || *d == ':')) d++; if (d - tokenbuf != len) { yylval.ival = OP_GLOB; @@ -3918,22 +4643,23 @@ char *start; if (!len) (void)strcpy(d,"ARGV"); if (*d == '$') { - GV *gv = gv_fetchpv(d+1,TRUE); - lex_op = (OP*)newUNOP(OP_READLINE, 0, - newUNOP(OP_RV2GV, 0, - newUNOP(OP_RV2SV, 0, - newGVOP(OP_GV, 0, gv)))); + I32 tmp; + if (tmp = pad_findmy(d)) { + OP *op = newOP(OP_PADSV, 0); + op->op_targ = tmp; + lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op)); + } + else { + GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV); + lex_op = (OP*)newUNOP(OP_READLINE, 0, + newUNOP(OP_RV2GV, 0, + newUNOP(OP_RV2SV, 0, + newGVOP(OP_GV, 0, gv)))); + } yylval.ival = OP_NULL; } else { - IO *io; - - GV *gv = gv_fetchpv(d,TRUE); - io = GvIOn(gv); - if (strEQ(d,"ARGV")) { - GvAVn(gv); - IoFLAGS(io) |= IOf_ARGV|IOf_START; - } + GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO); lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv)); yylval.ival = OP_NULL; } @@ -3948,11 +4674,14 @@ char *start; SV *sv; char *tmps; register char *s = start; - register char term = *s; + register char term; register char *to; I32 brackets = 1; + if (isSPACE(*s)) + s = skipspace(s); CLINE; + term = *s; multi_start = curcop->cop_line; multi_open = term; if (term && (tmps = strchr("([{< )]}> )]}>",term))) @@ -3962,7 +4691,7 @@ char *start; sv = NEWSV(87,80); sv_upgrade(sv, SVt_PVIV); SvIVX(sv) = term; - SvPOK_only(sv); /* validate pointer */ + (void)SvPOK_only(sv); /* validate pointer */ s++; for (;;) { SvGROW(sv, SvCUR(sv) + (bufend - s) + 1); @@ -3971,8 +4700,12 @@ char *start; for (; s < bufend; s++,to++) { if (*s == '\n' && !rsfp) curcop->cop_line++; - if (*s == '\\' && s+1 < bufend && term != '\\') - *to++ = *s++; + if (*s == '\\' && s+1 < bufend && term != '\\') { + if (s[1] == term) + s++; + else + *to++ = *s++; + } else if (*s == term) break; *to = *s; @@ -3982,8 +4715,12 @@ char *start; for (; s < bufend; s++,to++) { if (*s == '\n' && !rsfp) curcop->cop_line++; - if (*s == '\\' && s+1 < bufend && term != '\\') - *to++ = *s++; + if (*s == '\\' && s+1 < bufend && term != '\\') { + if (s[1] == term) + s++; + else + *to++ = *s++; + } else if (*s == term && --brackets <= 0) break; else if (*s == multi_open) @@ -3997,7 +4734,8 @@ char *start; if (s < bufend) break; /* string ends on this line? */ if (!rsfp || - !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) { + !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) { + sv_free(sv); curcop->cop_line = multi_start; return Nullch; } @@ -4145,11 +4883,11 @@ register char *s; { register char *eol; register char *t; - SV *stuff = newSV(0); + SV *stuff = newSVpv("",0); bool needargs = FALSE; while (!needargs) { - if (*s == '.') { + if (*s == '.' || *s == '}') { /*SUPPRESS 530*/ for (t = s+1; *t == ' ' || *t == '\t'; t++) ; if (*t == '\n') @@ -4163,19 +4901,21 @@ register char *s; else eol = bufend = SvPVX(linestr) + SvCUR(linestr); if (*s != '#') { - sv_catpvn(stuff, s, eol-s); - while (s < eol) { - if (*s == '@' || *s == '^') { - needargs = TRUE; - break; + for (t = s; t < eol; t++) { + if (*t == '~' && t[1] == '~' && SvCUR(stuff)) { + needargs = FALSE; + goto enough; /* ~~ must be first line in formline */ } - s++; + if (*t == '@' || *t == '^') + needargs = TRUE; } + sv_catpvn(stuff, s, eol-s); } s = eol; if (rsfp) { - s = sv_gets(linestr, rsfp, 0); - oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr); + s = filter_gets(linestr, rsfp, 0); + oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr); + bufend = bufptr + SvCUR(linestr); if (!s) { s = bufptr; yyerror("Format not terminated"); @@ -4184,14 +4924,16 @@ register char *s; } incline(s); } - if (SvPOK(stuff)) { + enough: + if (SvCUR(stuff)) { expect = XTERM; if (needargs) { + lex_state = LEX_NORMAL; nextval[nexttoke].ival = 0; force_next(','); } else - in_format = 2; + lex_state = LEX_FORMLINE; nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff); force_next(THING); nextval[nexttoke].ival = OP_FORMLINE; @@ -4199,7 +4941,7 @@ register char *s; } else { SvREFCNT_dec(stuff); - in_format = 0; + lex_formbrack = 0; bufptr = s; } return s; @@ -4218,16 +4960,29 @@ int start_subparse() { int oldsavestack_ix = savestack_ix; + CV* outsidecv = compcv; + AV* comppadlist; +#ifndef __QNX__ + if (compcv) { + assert(SvTYPE(compcv) == SVt_PVCV); + } +#endif save_I32(&subline); save_item(subname); SAVEINT(padix); SAVESPTR(curpad); SAVESPTR(comppad); SAVESPTR(comppad_name); + SAVESPTR(compcv); SAVEINT(comppad_name_fill); SAVEINT(min_intro_pending); SAVEINT(max_intro_pending); + SAVEINT(pad_reset_pending); + + compcv = (CV*)NEWSV(1104,0); + sv_upgrade((SV *)compcv, SVt_PVCV); + comppad = newAV(); comppad_name = newAV(); comppad_name_fill = 0; @@ -4235,8 +4990,16 @@ start_subparse() av_push(comppad, Nullsv); curpad = AvARRAY(comppad); padix = 0; - subline = curcop->cop_line; + + comppadlist = newAV(); + AvREAL_off(comppadlist); + av_store(comppadlist, 0, (SV*)comppad_name); + av_store(comppadlist, 1, (SV*)comppad); + + CvPADLIST(compcv) = comppadlist; + CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv); + return oldsavestack_ix; } @@ -4245,7 +5008,10 @@ yywarn(s) char *s; { --error_count; - return yyerror(s); + in_eval |= 2; + yyerror(s); + in_eval &= ~2; + return 0; } int @@ -4253,22 +5019,19 @@ yyerror(s) char *s; { char tmpbuf[258]; - char tmp2buf[258]; char *tname = tmpbuf; if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 && oldoldbufptr != oldbufptr && oldbufptr != bufptr) { while (isSPACE(*oldoldbufptr)) oldoldbufptr++; - cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr); - sprintf(tname,"near \"%s\"",tmp2buf); + sprintf(tname,"near \"%.*s\"",bufptr - oldoldbufptr, oldoldbufptr); } else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 && oldbufptr != bufptr) { while (isSPACE(*oldbufptr)) oldbufptr++; - cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr); - sprintf(tname,"near \"%s\"",tmp2buf); + sprintf(tname,"near \"%.*s\"",bufptr - oldbufptr, oldbufptr); } else if (yychar > 255) tname = "next token ???"; @@ -4278,8 +5041,10 @@ char *s; if (lex_state == LEX_NORMAL || (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL)) (void)strcpy(tname,"at end of line"); + else if (lex_inpat) + (void)strcpy(tname,"within pattern"); else - (void)strcpy(tname,"at end of string"); + (void)strcpy(tname,"within string"); } else if (yychar < 32) (void)sprintf(tname,"next char ^%c",yychar+64); @@ -4287,16 +5052,21 @@ char *s; (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 (curcop->cop_line == multi_end && multi_start < multi_end) { sprintf(buf+strlen(buf), - " (Might be a runaway multi-line %c%c string starting on line %d)\n", - multi_open,multi_close,multi_start); - if (in_eval) - sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf); + " (Might be a runaway multi-line %c%c string starting on line %ld)\n", + multi_open,multi_close,(long)multi_start); + multi_end = 0; + } + if (in_eval & 2) + warn("%s",buf); + else if (in_eval) + sv_catpv(GvSV(errgv),buf); else - fputs(buf,stderr); + PerlIO_printf(PerlIO_stderr(), "%s",buf); if (++error_count >= 10) croak("%s has too many errors.\n", SvPVX(GvSV(curcop->cop_filegv))); + in_my = 0; return 0; }