char q;
if (s) {
char *nl = strrchr(s,'\n');
- if (nl)
+ if (nl)
*nl = '\0';
}
else if (multi_close < 32 || multi_close == 127) {
PerlIO_clearerr(rsfp);
else
(void)PerlIO_close(rsfp);
- if (e_fp == rsfp)
- e_fp = Nullfp;
rsfp = Nullfp;
return s;
}
processing a pattern (lex_inpat is true), a transliteration
(lex_inwhat & OP_TRANS is true), or a double-quoted string.
+ Returns a pointer to the character scanned up to. Iff this is
+ advanced from the start pointer supplied (ie if anything was
+ successfully parsed), will leave an OP for the substring scanned
+ in yylval. Caller must intuit reason for not parsing further
+ by looking at the next characters herself.
+
In patterns:
backslashes:
double-quoted style: \r and \n
bool dorange = FALSE; /* are we in a translit range? */
I32 len; /* ? */
- /*
- leave is the set of acceptably-backslashed characters.
-
- I do *not* understand why there's the double hook here.
- */
+ /* leaveit is the set of acceptably-backslashed characters */
char *leaveit =
lex_inpat
? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
- : (lex_inwhat & OP_TRANS)
- ? ""
- : "";
+ : "";
while (s < send || dorange) {
/* get transliterations out of the way (they're most literal) */
*d++ = *s++;
} else if (s[2] == '{') { /* This should march regcomp.c */
I32 count = 1;
- char *pregparse = s + 3;
+ char *regparse = s + 3;
char c;
- while (count && (c = *pregparse)) {
- if (c == '\\' && pregparse[1])
- pregparse++;
+ while (count && (c = *regparse)) {
+ if (c == '\\' && regparse[1])
+ regparse++;
else if (c == '{')
count++;
else if (c == '}')
count--;
- pregparse++;
+ regparse++;
}
- if (*pregparse == ')')
- pregparse++;
+ if (*regparse == ')')
+ regparse++;
else
yyerror("Sequence (?{...}) not terminated or not {}-balanced");
- while (s < pregparse && *s != ')')
+ while (s < regparse && *s != ')')
*d++ = *s++;
}
}
Renew(SvPVX(sv), SvLEN(sv), char);
}
- /* ??? */
+ /* return the substring (via yylval) only if we parsed anything */
if (s > bufptr)
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
else
else {
int weight = 2; /* let's weigh the evidence */
char seen[256];
- unsigned char un_char = 0, last_un_char;
+ unsigned char un_char = 255, last_un_char;
char *send = strchr(s,']');
char tmpbuf[sizeof tokenbuf * 4];
weight += 30;
if (strchr("zZ79~",s[1]))
weight += 30;
+ if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
+ weight -= 5; /* cope with negative subscript */
break;
default:
if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
/* 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);
+ return (*funcp)(PERL_OBJECT_THIS_ idx, buf_sv, maxlen);
}
STATIC char *
PerlIO_clearerr(rsfp);
else
(void)PerlIO_close(rsfp);
- if (e_fp == rsfp)
- e_fp = Nullfp;
rsfp = Nullfp;
}
if (!in_eval && (minus_n || minus_p)) {
else
lex_brackstack[lex_brackets++] = XOPERATOR;
s = skipspace(s);
- if (*s == '}') {
- if (expect == XSTATE) {
- lex_brackstack[lex_brackets-1] = XSTATE;
- break;
- }
+ if (*s == '}')
OPERATOR(HASHBRACK);
- }
/* This hack serves to disambiguate a pair of curlies
* as being a block or an anon hash. Normally, expectation
* determines that, but in cases where we're not in a
s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
TRUE, &morelen);
if (!morelen)
- croak("Bad name after %s::", tokenbuf);
+ croak("Bad name after %s%s", tokenbuf,
+ *s == '\'' ? "'" : "::");
len += morelen;
}
oldoldbufptr < bufptr &&
(oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
/* NO SKIPSPACE BEFORE HERE! */
- (expect == XREF ||
- ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF) )
+ (expect == XREF
+ || ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
+ || (last_lop_op == OP_ENTERSUB
+ && last_proto
+ && last_proto[last_proto[0] == ';' ? 1 : 0] == '*')) )
{
bool immediate_paren = *s == '(';
/* Is there a prototype? */
if (SvPOK(cv)) {
STRLEN len;
- char *proto = SvPV((SV*)cv, len);
+ last_proto = SvPV((SV*)cv, len);
if (!len)
TERM(FUNC0SUB);
- if (strEQ(proto, "$"))
+ if (strEQ(last_proto, "$"))
OPERATOR(UNIOPSUB);
- if (*proto == '&' && *s == '{') {
+ if (*last_proto == '&' && *s == '{') {
sv_setpv(subname,"__ANON__");
PREBLOCK(LSTOPSUB);
}
- }
+ } else
+ last_proto = NULL;
nextval[nexttoke].opval = yylval.opval;
expect = XTERM;
force_next(WORD);
*pmfl |= PMf_MULTILINE;
else if (ch == 's')
*pmfl |= PMf_SINGLELINE;
+ else if (ch == 't')
+ *pmfl |= PMf_TAINTMEM;
else if (ch == 'x')
*pmfl |= PMf_EXTENDED;
}
pm = (PMOP*)newPMOP(OP_MATCH, 0);
if (multi_open == '?')
pm->op_pmflags |= PMf_ONCE;
- while (*s && strchr("iogcmsx", *s))
+ while (*s && strchr("iogcmstx", *s))
pmflag(&pm->op_pmflags,*s++);
pm->op_pmpermflags = pm->op_pmflags;
multi_start = first_start; /* so whole substitution is taken together */
pm = (PMOP*)newPMOP(OP_SUBST, 0);
- while (*s && strchr("iogcmsex", *s)) {
+ while (*s) {
if (*s == 'e') {
s++;
es++;
}
- else
+ else if (strchr("iogcmstx", *s))
pmflag(&pm->op_pmflags,*s++);
+ else
+ break;
}
if (es) {
s--, herewas = newSVpv(s,d-s);
s += SvCUR(herewas);
- tmpstr = NEWSV(87,80);
+ tmpstr = NEWSV(87,79);
sv_upgrade(tmpstr, SVt_PVIV);
if (term == '\'') {
op_type = OP_CONST;
}
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
- curcop->cop_line++; /* the preceding stmt passes a newline */
+ curcop->cop_line++; /* the preceding stmt passes a newline */
sv_catpvn(herewas,s,bufend-s);
sv_setsv(linestr,herewas);
multi_close = term;
/* create a new SV to hold the contents. 87 is leak category, I'm
- assuming. 80 is the SV's initial length. What a random number. */
- sv = NEWSV(87,80);
+ assuming. 79 is the SV's initial length. What a random number. */
+ sv = NEWSV(87,79);
sv_upgrade(sv, SVt_PVIV);
SvIVX(sv) = term;
(void)SvPOK_only(sv); /* validate pointer */