summaryrefslogtreecommitdiff
path: root/toke.c
diff options
context:
space:
mode:
authorLarry Wall <lwall@netlabs.com>1995-03-12 22:32:14 -0800
committerLarry Wall <lwall@netlabs.com>1995-03-12 22:32:14 -0800
commit748a93069b3d16374a9859d1456065dd3ae11394 (patch)
tree308ca14de9933a313dceacce8be77db67d9368c7 /toke.c
parentfec02dd38faf8f83471b031857d89cb76fea1ca0 (diff)
downloadperl-748a93069b3d16374a9859d1456065dd3ae11394.tar.gz
Perl 5.001perl-5.001
[See the Changes file for a list of changes]
Diffstat (limited to 'toke.c')
-rw-r--r--toke.c435
1 files changed, 252 insertions, 183 deletions
diff --git a/toke.c b/toke.c
index 51efcc9c40..99d0e6182c 100644
--- a/toke.c
+++ b/toke.c
@@ -116,8 +116,6 @@ static int uni _((I32 f, char *s));
/* grandfather return to old style */
#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
-static cryptswitch_t cryptswitch_fp = NULL;
-
static int
ao(toketype)
int toketype;
@@ -139,13 +137,24 @@ char *what;
char *s;
{
char tmpbuf[128];
- char *oldbufptr = bufptr;
+ char *oldbp = bufptr;
+ bool is_first = (oldbufptr == SvPVX(linestr));
bufptr = s;
sprintf(tmpbuf, "%s found where operator expected", what);
yywarn(tmpbuf);
- if (oldbufptr == SvPVX(linestr))
+ if (is_first)
warn("\t(Missing semicolon on previous line?)\n");
- bufptr = oldbufptr;
+ 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
@@ -478,15 +487,18 @@ 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)
+ if (kind) {
+ op->op_private = OPpCONST_ENTERED;
gv_fetchpv(s, TRUE,
kind == '$' ? SVt_PV :
kind == '@' ? SVt_PVAV :
kind == '%' ? SVt_PVHV :
SVt_PVGV
);
+ }
}
}
@@ -503,6 +515,8 @@ SV *sv;
return sv;
s = SvPV_force(sv, len);
+ if (SvIVX(sv) == -1)
+ return sv;
send = s + len;
while (s < send && *s != '\\')
s++;
@@ -645,12 +659,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
- ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"
+ ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
: (lex_inwhat & OP_TRANS)
? ""
: "";
@@ -675,6 +688,15 @@ char *start;
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 == '$') {
@@ -685,12 +707,6 @@ char *start;
}
if (*s == '\\' && s+1 < send) {
s++;
-#ifdef NOTDEF
- if (*s == delim) {
- *d++ = *s++;
- continue;
- }
-#endif
if (*s && strchr(leave, *s)) {
*d++ = '\\';
*d++ = *s++;
@@ -978,8 +994,10 @@ cryptswitch_add(funcp)
}
-static char* exp_name[] =
+#ifdef DEBUGGING
+ static char* exp_name[] =
{ "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
+#endif
extern int yychar; /* last token */
@@ -1219,9 +1237,13 @@ yylex()
goto retry;
}
/* Give cryptswitch a chance. Note that cryptswitch_fp may */
- /* be called several times owing to "goto retry;"'s below. */
- if (cryptswitch_fp)
- rsfp = (*cryptswitch_fp)(rsfp);
+ /* be either be called once if it redirects rsfp and unregisters */
+ /* itself, or it may be called on every line if it loads linestr. */
+ if (cryptswitch_fp && (*cryptswitch_fp)()) {
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ goto retry;
+ }
do {
if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) {
fake_eof:
@@ -1275,8 +1297,14 @@ yylex()
if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
s++;
if (!in_eval && *s == '#' && s[1] == '!') {
- if (!instr(s,"perl") && !instr(s,"indir") &&
- instr(origargv[0],"perl")) {
+ 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;
@@ -1303,24 +1331,28 @@ yylex()
execv(cmd,newargv);
croak("Can't exec %s", cmd);
}
- if (d = instr(s, "perl -")) {
+ if (d) {
int oldpdb = perldb;
int oldn = minus_n;
int oldp = minus_p;
- d += 6;
- /*SUPPRESS 530*/
- while (d = moreswitches(d)) ;
- if (perldb && !oldpdb ||
- minus_n && !oldn ||
- minus_p && !oldp)
- {
- sv_setpv(linestr, "");
- oldoldbufptr = oldbufptr = s = SvPVX(linestr);
- bufend = SvPVX(linestr) + SvCUR(linestr);
- preambled = FALSE;
- if (perldb)
- (void)gv_fetchfile(origfilename);
- goto retry;
+
+ while (*d && !isSPACE(*d)) d++;
+ while (*d == ' ') d++;
+
+ if (*d++ == '-') {
+ while (d = moreswitches(d)) ;
+ if (perldb && !oldpdb ||
+ minus_n && !oldn ||
+ minus_p && !oldp)
+ {
+ sv_setpv(linestr, "");
+ oldoldbufptr = oldbufptr = s = SvPVX(linestr);
+ bufend = SvPVX(linestr) + SvCUR(linestr);
+ preambled = FALSE;
+ if (perldb)
+ (void)gv_fetchfile(origfilename);
+ goto retry;
+ }
}
}
}
@@ -1357,9 +1389,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;
last_lop_op = OP_FTEREAD; /* good enough */
- switch (*s++) {
+ switch (tmp) {
case 'r': FTST(OP_FTEREAD);
case 'w': FTST(OP_FTEWRITE);
case 'x': FTST(OP_FTEEXEC);
@@ -1388,7 +1433,7 @@ yylex()
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;
}
}
@@ -1407,8 +1452,10 @@ yylex()
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);
@@ -1459,7 +1506,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);
@@ -1549,8 +1596,24 @@ yylex()
lex_brackstack[lex_brackets++] = XOPERATOR;
OPERATOR(HASHBRACK);
break;
- case XBLOCK:
case XOPERATOR:
+ while (s < bufend && (*s == ' ' || *s == '\t'))
+ s++;
+ if (s < bufend && isALPHA(*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;
break;
@@ -1614,6 +1677,11 @@ yylex()
lex_state = LEX_INTERPEND;
}
}
+ if (lex_brackets < lex_fakebrack) {
+ bufptr = s;
+ lex_fakebrack = 0;
+ return yylex(); /* ignore fake brackets */
+ }
force_next('}');
TOKEN(';');
case '&':
@@ -1659,7 +1727,9 @@ yylex()
if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
warn("Reversed %c= operator",tmp);
s--;
- if (isALPHA(tmp) && s == SvPVX(linestr)+1) {
+ if (expect == XSTATE && isALPHA(tmp) &&
+ (s == SvPVX(linestr)+1 || s[-2] == '\n') )
+ {
s = bufend;
doextract = TRUE;
goto retry;
@@ -1718,7 +1788,7 @@ yylex()
Rop(OP_GT);
case '$':
- if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$", s[2]))) {
+ if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
s = scan_ident(s+1, bufend, tokenbuf+1, FALSE);
if (expect == XOPERATOR) {
if (lex_formbrack && lex_brackets == lex_formbrack) {
@@ -1760,8 +1830,9 @@ yylex()
/* This kludge not intended to be bulletproof. */
if (tokenbuf[1] == '[' && !tokenbuf[2]) {
- yylval.opval = newSVOP(OP_CONST, OPf_SPECIAL,
+ yylval.opval = newSVOP(OP_CONST, 0,
newSViv((IV)compiling.cop_arybase));
+ yylval.opval->op_private = OPpCONST_ARYBASE;
TERM(THING);
}
tokenbuf[0] = '$';
@@ -1779,12 +1850,13 @@ yylex()
if (*s == '{' && strEQ(tokenbuf, "$SIG") &&
(t = strchr(s,'}')) && (t = strchr(t,'='))) {
char tmpbuf[1024];
- char *d = tmpbuf;
STRLEN len;
for (t++; isSPACE(*t); t++) ;
- t = scan_word(t, tmpbuf, TRUE, &len);
- if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
- warn("You need to quote \"%s\"", tmpbuf);
+ 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;
@@ -1808,13 +1880,13 @@ 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 (oldexpect != XREF) {
+ if (oldexpect != XREF || oldoldbufptr == last_lop) {
if (*s == '[')
tokenbuf[0] = '@';
else if (*s == '{')
@@ -1825,8 +1897,15 @@ yylex()
nextval[nexttoke].opval->op_targ = tmp;
force_next(PRIVATEREF);
}
- else
+ else {
+ if ((tainting || !euid) &&
+ !isLOWER(tokenbuf[1]) &&
+ (isDIGIT(tokenbuf[1]) ||
+ strchr("&`'+", tokenbuf[1]) ||
+ instr(tokenbuf,"MATCH") ))
+ hints |= HINT_BLOCK_SCOPE; /* Can't optimize block out*/
force_ident(tokenbuf+1, *tokenbuf);
+ }
}
else
force_ident(tokenbuf+1, *tokenbuf);
@@ -1849,7 +1928,7 @@ yylex()
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);
@@ -1914,7 +1993,8 @@ yylex()
OPERATOR(tmp);
case '.':
- if (lex_formbrack && lex_brackets == lex_formbrack && s == oldbufptr) {
+ if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
+ (s == SvPVX(linestr) || s[-1] == '\n') ) {
lex_formbrack = 0;
expect = XSTATE;
goto rightbracket;
@@ -1987,6 +2067,8 @@ yylex()
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);
@@ -2027,10 +2109,25 @@ yylex()
case 'z': case 'Z':
keylookup:
- d = s;
+ bufptr = s;
s = scan_word(s, tokenbuf, FALSE, &len);
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 &&
@@ -2051,6 +2148,7 @@ yylex()
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 */
@@ -2100,6 +2198,8 @@ yylex()
(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);
@@ -2111,12 +2211,10 @@ yylex()
/* 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 || !gv || !GvCV(gv)) {
- expect = last_lop == oldoldbufptr ? XTERM : XOPERATOR;
- for (d = tokenbuf; *d && isLOWER(*d); d++) ;
- if (dowarn && !*d)
- warn(warn_reserved, tokenbuf);
- TOKEN(WORD);
+ if (last_lop_op == OP_SORT ||
+ (!immediate_paren && (!gv || !GvCV(gv))) ) {
+ expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
+ goto bareword;
}
}
@@ -2154,13 +2252,18 @@ yylex()
force_next(WORD);
TOKEN('&');
}
+ if (lastchar == '-')
+ warn("Ambiguious use of -%s resolved as -&%s()",
+ tokenbuf, tokenbuf);
last_lop = oldbufptr;
last_lop_op = OP_ENTERSUB;
expect = XTERM;
force_next(WORD);
TOKEN(NOAMP);
}
- else if (hints & HINT_STRICT_SUBS &&
+
+ if (hints & HINT_STRICT_SUBS &&
+ lastchar != '-' &&
strnNE(s,"->",2) &&
last_lop_op != OP_ACCEPT &&
last_lop_op != OP_PIPE_OP &&
@@ -2174,9 +2277,20 @@ yylex()
/* 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("Ambiguious use of %c resolved as operator %c",
+ lastchar, lastchar);
+ }
TOKEN(WORD);
}
@@ -2195,7 +2309,7 @@ yylex()
/*SUPPRESS 560*/
if (!in_eval) {
- gv = gv_fetchpv("DATA",TRUE, SVt_PVIO);
+ gv = gv_fetchpv("main::DATA",TRUE, SVt_PVIO);
SvMULTI_on(gv);
if (!GvIO(gv))
GvIOp(gv) = newIO();
@@ -2230,6 +2344,7 @@ yylex()
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)
@@ -2292,9 +2407,11 @@ yylex()
LOP(OP_CRYPT,XTERM);
case KEY_chmod:
- s = skipspace(s);
- if (dowarn && *s != '0' && isDIGIT(*s))
- yywarn("chmod: mode argument is missing initial 0");
+ 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:
@@ -2725,8 +2842,11 @@ yylex()
OLDLOP(OP_RETURN);
case KEY_require:
+ *tokenbuf = '\0';
s = force_word(s,WORD,TRUE,TRUE,FALSE);
- if (*s == '<')
+ if (isIDFIRST(*tokenbuf))
+ gv_stashpv(tokenbuf, TRUE);
+ else if (*s == '<')
yyerror("<> should be quotes");
UNI(OP_REQUIRE);
@@ -3003,9 +3123,11 @@ yylex()
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:
@@ -3751,10 +3873,10 @@ 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;
@@ -3786,11 +3908,10 @@ I32 ck_uni;
lex_state = LEX_INTERPENDMAYBE;
return s;
}
- if (*s == '$' && s[1] && (isALPHA(s[1]) || strchr("$_{", s[1])))
+ if (*s == '$' && s[1] &&
+ (isALPHA(s[1]) || strchr("$_{", s[1]) || strnEQ(s+1,"::",2)) )
return s;
if (*s == '{') {
- if (lex_state == LEX_NORMAL)
- return s;
bracket = s;
s++;
}
@@ -3799,19 +3920,27 @@ 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 == '{') && !keyword(dest,d-dest)) {
- 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_brackstack[lex_brackets++] = XOPERATOR;
return s;
@@ -3821,6 +3950,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 */
@@ -3832,99 +3967,6 @@ I32 ck_uni;
return s;
}
-#ifdef NOTDEF
-void
-scan_prefix(pm,string,len)
-PMOP *pm;
-char *string;
-I32 len;
-{
- 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 '(':
- if (d[1] == '?') { /* All bets off. */
- SvREFCNT_dec(tmpstr);
- return;
- }
- /* FALL THROUGH */
- case '.': case '[': case '$': case ')': case '|': case '+':
- case '^':
- e = d;
- break;
- case '\\':
- if (d[1] && strchr("AGZwWbB0123456789sSdDlLuUExc",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;
- }
- *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;
-}
-#endif
-
void pmflag(pmfl,ch)
U16* pmfl;
int ch;
@@ -4045,6 +4087,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 &&
@@ -4065,6 +4108,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;
}
@@ -4164,17 +4208,21 @@ 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);
- sv_upgrade(tmpstr, SVt_PVIV);
- SvIVX(tmpstr) = '\\';
term = *tokenbuf;
if (!rsfp) {
d = s;
@@ -4582,6 +4630,8 @@ int
start_subparse()
{
int oldsavestack_ix = savestack_ix;
+ CV* outsidecv = compcv;
+ AV* comppadlist;
save_I32(&subline);
save_item(subname);
@@ -4589,9 +4639,15 @@ start_subparse()
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();
SAVEFREESV((SV*)comppad);
comppad_name = newAV();
@@ -4601,8 +4657,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, SvREFCNT_inc((SV*)comppad_name));
+ av_store(comppadlist, 1, SvREFCNT_inc((SV*)comppad));
+
+ CvPADLIST(compcv) = comppadlist;
+ CvOUTSIDE(compcv) = outsidecv;
+
return oldsavestack_ix;
}
@@ -4611,7 +4675,10 @@ yywarn(s)
char *s;
{
--error_count;
- return yyerror(s);
+ in_eval |= 2;
+ yyerror(s);
+ in_eval &= ~2;
+ return 0;
}
int
@@ -4656,7 +4723,9 @@ char *s;
multi_open,multi_close,(long)multi_start);
multi_end = 0;
}
- if (in_eval)
+ if (in_eval & 2)
+ warn("%s",buf);
+ else if (in_eval)
sv_catpv(GvSV(gv_fetchpv("@",TRUE, SVt_PV)),buf);
else
fputs(buf,stderr);