/* toke.c
*
- * Copyright (c) 1991-1994, Larry Wall
+ * Copyright (c) 1991-1997, 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.
char *what;
char *s;
{
- char tmpbuf[128];
char *oldbp = bufptr;
bool is_first = (oldbufptr == linestart);
+ char *msg;
+
bufptr = s;
- sprintf(tmpbuf, "%s found where operator expected", what);
- yywarn(tmpbuf);
+ New(890, msg, strlen(what) + 40, char);
+ sprintf(msg, "%s found where operator expected", what);
+ yywarn(msg);
+ Safefree(msg);
if (is_first)
warn("\t(Missing semicolon on previous line?)\n");
else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) {
return THING;
}
if (op_type == OP_CONST || op_type == OP_READLINE) {
- yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
+ SV *sv = q(lex_stuff);
+ STRLEN len;
+ char *p = SvPV(sv, len);
+ yylval.opval = (OP*)newSVOP(op_type, 0, newSVpv(p, len));
+ SvREFCNT_dec(sv);
lex_stuff = Nullsv;
return THING;
}
die("Can't upgrade filter_add data to SVt_PVIO");
IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
if (filter_debug)
- warn("filter_add func %lx (%s)", funcp, SvPV(datasv,na));
+ warn("filter_add func %p (%s)", funcp, SvPV(datasv,na));
av_unshift(rsfp_filters, 1);
av_store(rsfp_filters, 0, datasv) ;
return(datasv);
filter_t funcp;
{
if (filter_debug)
- warn("filter_del func %lx", funcp);
+ warn("filter_del func %p", funcp);
if (!rsfp_filters || AvFILL(rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
/* Get function pointer hidden within datasv */
funcp = (filter_t)IoDIRP(datasv);
if (filter_debug)
- warn("filter_read %d: via function %lx (%s)\n",
+ warn("filter_read %d: via function %p (%s)\n",
idx, funcp, SvPV(datasv,na));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
GV *gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV);
if (!gv || ((tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv))) {
char tmpbuf[1024];
- sprintf(tmpbuf, "Literal %s now requires backslash", tokenbuf);
+ sprintf(tmpbuf, "In string, %s now must be written as \\%s",
+ tokenbuf, tokenbuf);
yyerror(tmpbuf);
}
}
s = bufptr;
Aop(OP_CONCAT);
}
- else
- return yylex();
- break;
+ return yylex();
case LEX_INTERPENDMAYBE:
if (intuit_more(bufptr)) {
retry:
switch (*s) {
default:
- warn("Unrecognized character \\%03o ignored", *s++ & 255);
- goto retry;
+ croak("Unrecognized character \\%03o", *s & 255);
case 4:
case 26:
goto fake_eof; /* emulate EOF on ^D or ^Z */
sv_catpv(linestr, "LINE: while (<>) {");
if (minus_l)
sv_catpv(linestr,"chomp;");
- if (minus_a){
- if (minus_F){
- char tmpbuf1[50];
- if ( splitstr[0] == '/' ||
- splitstr[0] == '\'' ||
- splitstr[0] == '"' )
- sprintf( tmpbuf1, "@F=split(%s);", splitstr );
- else
- sprintf( tmpbuf1, "@F=split('%s');", splitstr );
- sv_catpv(linestr,tmpbuf1);
+ if (minus_a) {
+ GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV);
+ if (gv)
+ GvIMPORTED_AV_on(gv);
+ if (minus_F) {
+ char *tmpbuf1;
+ New(201, tmpbuf1, strlen(splitstr) * 2 + 20, char);
+ if (strchr("/'\"", *splitstr)
+ && strchr(splitstr + 1, *splitstr))
+ sprintf(tmpbuf1, "@F=split(%s);", splitstr);
+ else {
+ char delim;
+ s = "'~#\200\1'"; /* surely one char is unused...*/
+ while (s[1] && strchr(splitstr, *s)) s++;
+ delim = *s;
+ sprintf(tmpbuf1, "@F=split(%s%c",
+ "q" + (delim == '\''), delim);
+ d = tmpbuf1 + strlen(tmpbuf1);
+ for (s = splitstr; *s; ) {
+ if (*s == '\\')
+ *d++ = '\\';
+ *d++ = *s++;
+ }
+ sprintf(d, "%c);", delim);
+ }
+ sv_catpv(linestr,tmpbuf1);
+ Safefree(tmpbuf1);
}
else
sv_catpv(linestr,"@F=split(' ');");
*/
SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
assert(SvPOK(x) || SvGMAGICAL(x));
- if (sv_eq(x, GvSV(curcop->cop_filegv)))
+ if (sv_eq(x, GvSV(curcop->cop_filegv))) {
sv_setpvn(x, ipath, ipathend - ipath);
+ SvSETMAGIC(x);
+ }
TAINT_NOT; /* $^X is always tainted, but that's OK */
}
#endif /* ARG_ZERO_IS_SCRIPT */
while (*d == ' ' || *d == '\t') d++;
if (*d++ == '-') {
- while (d = moreswitches(d)) ;
+ do {
+ if (*d == 'M' || *d == 'm') {
+ char *m = d;
+ while (*d && !isSPACE(*d)) d++;
+ croak("Too late for \"-%.*s\" option",
+ (int)(d - m), m);
+ }
+ d = moreswitches(d);
+ } while (d);
if (perldb && !oldpdb ||
( minus_n || minus_p ) && !(oldn || oldp) )
/* if we have already added "LINE: while (<>) {",
return yylex();
}
goto retry;
- case ' ': case '\t': case '\f': case '\r': case 013:
+ case '\r':
+ warn("Illegal character \\%03o (carriage return)", '\r');
+ croak(
+ "(Maybe you didn't strip carriage returns after a network transfer?)\n");
+ case ' ': case '\t': case '\f': case 013:
s++;
goto retry;
case '#':
if (strnEQ(s,"=>",2)) {
if (dowarn)
warn("Ambiguous use of -%c => resolved to \"-%c\" =>",
- tmp, tmp);
+ (int)tmp, (int)tmp);
s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
OPERATOR('-'); /* unary minus */
}
case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
default:
- croak("Unrecognized file test: -%c", tmp);
+ croak("Unrecognized file test: -%c", (int)tmp);
break;
}
}
else
lex_brackstack[lex_brackets++] = XOPERATOR;
OPERATOR(HASHBRACK);
- break;
case XOPERATOR:
while (s < bufend && (*s == ' ' || *s == '\t'))
s++;
if (tmp == '~')
PMop(OP_MATCH);
if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
- warn("Reversed %c= operator",tmp);
+ warn("Reversed %c= operator",(int)tmp);
s--;
if (expect == XSTATE && isALPHA(tmp) &&
(s == linestart+1 || s[-2] == '\n') )
expect = XTERM; /* e.g. print $fh "foo" */
else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
expect = XTERM; /* e.g. print $fh &sub */
+ else if (isIDFIRST(*s)) {
+ char tmpbuf[1024];
+ scan_word(s, tmpbuf, TRUE, &len);
+ if (keyword(tmpbuf, len))
+ expect = XTERM; /* e.g. print $fh length() */
+ else {
+ GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
+ if (gv && GvCVu(gv))
+ expect = XTERM; /* e.g. print $fh subr() */
+ }
+ }
else if (isDIGIT(*s))
expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
curcop->cop_line++;
}
else
- no_op("Bare word",s);
+ no_op("Bareword",s);
}
/* Look for a subroutine with this name in current package. */
TOKEN(WORD);
}
+ case KEY___FILE__:
case KEY___LINE__:
- case KEY___FILE__: {
if (tokenbuf[2] == 'L')
(void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
else
strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv)));
yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
TERM(THING);
- }
+
+ case KEY___PACKAGE__:
+ yylval.opval = (OP*)newSVOP(OP_CONST, 0,
+ (curstash
+ ? newSVsv(curstname)
+ : &sv_undef));
+ TERM(THING);
case KEY___DATA__:
case KEY___END__: {
/* Look for a prototype */
if (*s == '(') {
+ char *p;
+
s = scan_str(s);
if (!s) {
if (lex_stuff)
lex_stuff = Nullsv;
croak("Prototype not terminated");
}
+ /* strip spaces */
+ d = SvPVX(lex_stuff);
+ tmp = 0;
+ for (p = d; *p; ++p) {
+ if (!isSPACE(*p))
+ d[tmp++] = *p;
+ }
+ d[tmp] = '\0';
+ SvCUR(lex_stuff) = tmp;
+
nexttoke++;
nextval[1] = nextval[0];
nexttype[1] = nexttype[0];
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,"__PACKAGE__")) return -KEY___PACKAGE__;
if (strEQ(d,"__DATA__")) return KEY___DATA__;
if (strEQ(d,"__END__")) return KEY___END__;
}
return s;
}
if (*s == '$' && s[1] &&
- (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) )
- return s;
+ (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+ {
+ if (isDIGIT(s[1]) && lex_state == LEX_INTERPNORMAL)
+ deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
+ else
+ return s;
+ }
if (*s == '{') {
bracket = s;
s++;
{
register char *s;
register PMOP *pm;
+ I32 first_start;
I32 es = 0;
yylval.ival = OP_NULL;
if (s[-1] == multi_open)
s--;
+ first_start = multi_start;
s = scan_str(s);
if (!s) {
if (lex_stuff)
lex_repl = Nullsv;
croak("Substitution replacement not terminated");
}
+ multi_start = first_start; /* so whole substitution is taken together */
pm = (PMOP*)newPMOP(OP_SUBST, 0);
while (*s && strchr("iogmsex", *s)) {
}
}
/* promote the better string */
- if ((!pm->op_pmshort && !(pm->op_pmregexp->reganch & ROPT_ANCH)) ||
+ if ((!pm->op_pmshort &&
+ !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) ||
((pm->op_pmflags & PMf_SCANFIRST) &&
(SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
SvREFCNT_dec(pm->op_pmshort); /* ok if null */
{
register char *s = start;
register char *d;
- I32 tryi32;
+ I32 tryiv;
double value;
SV *sv;
I32 floatit;
sv = NEWSV(92,0);
SET_NUMERIC_STANDARD();
value = atof(tokenbuf);
- tryi32 = I_32(value);
- if (!floatit && (double)tryi32 == value)
- sv_setiv(sv,tryi32);
+ tryiv = I_V(value);
+ if (!floatit && (double)tryiv == value)
+ sv_setiv(sv, tryiv);
else
- sv_setnv(sv,value);
+ sv_setnv(sv, value);
break;
}
yyerror(s)
char *s;
{
- char tmpbuf[258];
- char *tname = tmpbuf;
-
- if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+ char wbuf[40];
+ char *where = NULL;
+ char *context = NULL;
+ int contlen = -1;
+
+ if (!yychar || (yychar == ';' && !rsfp))
+ where = "at EOF";
+ else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
while (isSPACE(*oldoldbufptr))
oldoldbufptr++;
- sprintf(tname,"near \"%.*s\"",bufptr - oldoldbufptr, oldoldbufptr);
+ context = oldoldbufptr;
+ contlen = bufptr - oldoldbufptr;
}
else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
oldbufptr != bufptr) {
while (isSPACE(*oldbufptr))
oldbufptr++;
- sprintf(tname,"near \"%.*s\"",bufptr - oldbufptr, oldbufptr);
+ context = oldbufptr;
+ contlen = bufptr - oldbufptr;
}
else if (yychar > 255)
- tname = "next token ???";
- else if (!yychar || (yychar == ';' && !rsfp))
- (void)strcpy(tname,"at EOF");
+ where = "next token ???";
else if ((yychar & 127) == 127) {
if (lex_state == LEX_NORMAL ||
(lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
- (void)strcpy(tname,"at end of line");
+ where = "at end of line";
else if (lex_inpat)
- (void)strcpy(tname,"within pattern");
+ where = "within pattern";
else
- (void)strcpy(tname,"within string");
+ where = "within string";
}
else if (yychar < 32)
- (void)sprintf(tname,"next char ^%c",toCTRL(yychar));
+ (void)sprintf(where = wbuf, "next char ^%c", toCTRL(yychar));
+ else if (isPRINT_LC(yychar))
+ (void)sprintf(where = wbuf, "next char %c", yychar);
+ else
+ (void)sprintf(where = wbuf, "next char \\%03o", yychar & 255);
+ if (contlen == -1)
+ contlen = strlen(where);
+ (void)sprintf(buf, "%s at %s line %d, ",
+ s, SvPVX(GvSV(curcop->cop_filegv)), curcop->cop_line);
+ if (context)
+ (void)sprintf(buf+strlen(buf), "near \"%.*s\"\n", contlen, context);
else
- (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) {
+ (void)sprintf(buf+strlen(buf), "%s\n", where);
+ if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
sprintf(buf+strlen(buf),
- " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
- multi_open,multi_close,(long)multi_start);
+ " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
+ (int)multi_open,(int)multi_close,(long)multi_start);
multi_end = 0;
}
if (in_eval & 2)
projects / p5sagit/p5-mst-13.2.git / blobdiff