/* toke.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
(prevlen = SvCUR(PL_linestr)))) == Nullch)
{
/* end of file. Add on the -p or -n magic */
- if (PL_minus_n || PL_minus_p) {
- sv_setpv(PL_linestr,PL_minus_p ?
- ";}continue{print or die qq(-p destination: $!\\n)" :
- "");
- sv_catpv(PL_linestr,";}");
+ if (PL_minus_p) {
+ sv_setpv(PL_linestr,
+ ";}continue{print or die qq(-p destination: $!\\n);}");
PL_minus_n = PL_minus_p = 0;
}
+ else if (PL_minus_n) {
+ sv_setpvn(PL_linestr, ";}", 2);
+ PL_minus_n = 0;
+ }
else
- sv_setpv(PL_linestr,";");
+ sv_setpvn(PL_linestr,";", 1);
/* reset variables for next time we lex */
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart
weight -= 5; /* cope with negative subscript */
break;
default:
- if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
- isALPHA(*s) && s[1] && isALPHA(s[1])) {
+ if (!isALNUM(last_un_char)
+ && !(last_un_char == '$' || last_un_char == '@'
+ || last_un_char == '&')
+ && isALPHA(*s) && s[1] && isALPHA(s[1])) {
char *d = tmpbuf;
while (isALPHA(*s))
*d++ = *s++;
oldmod = PL_lex_casestack[--PL_lex_casemods];
PL_lex_casestack[PL_lex_casemods] = '\0';
- if (PL_bufptr != PL_bufend && strchr("LUQ", oldmod)) {
+ if (PL_bufptr != PL_bufend
+ && (oldmod == 'L' || oldmod == 'U' || oldmod == 'Q')) {
PL_bufptr += 2;
PL_lex_state = LEX_INTERPCONCAT;
}
else {
if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
tmp = *s, *s = s[2], s[2] = (char)tmp; /* misordered... */
- if (strchr("LU", *s) &&
+ if ((*s == 'L' || *s == 'U') &&
(strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U'))) {
PL_lex_casestack[--PL_lex_casemods] = '\0';
return REPORT(')');
PL_preambled = TRUE;
sv_setpv(PL_linestr,incl_perldb());
if (SvCUR(PL_linestr))
- sv_catpv(PL_linestr,";");
+ sv_catpvn(PL_linestr,";", 1);
if (PL_preambleav){
while(AvFILLp(PL_preambleav) >= 0) {
SV *tmpsv = av_shift(PL_preambleav);
sv_catsv(PL_linestr, tmpsv);
- sv_catpv(PL_linestr, ";");
+ sv_catpvn(PL_linestr, ";", 1);
sv_free(tmpsv);
}
sv_free((SV*)PL_preambleav);
sv_catpv(PL_linestr,"chomp;");
if (PL_minus_a) {
if (PL_minus_F) {
- if (strchr("/'\"", *PL_splitstr)
+ if ((*PL_splitstr == '/' || *PL_splitstr == '\''
+ || *PL_splitstr == '"')
&& strchr(PL_splitstr + 1, *PL_splitstr))
Perl_sv_catpvf(aTHX_ PL_linestr, "our @F=split(%s);", PL_splitstr);
else {
- char delim;
- s = "'~#\200\1'"; /* surely one char is unused...*/
- while (s[1] && strchr(PL_splitstr, *s)) s++;
- delim = *s;
- Perl_sv_catpvf(aTHX_ PL_linestr, "our @F=split(%s%c",
- "q" + (delim == '\''), delim);
- for (s = PL_splitstr; *s; s++) {
- if (*s == '\\')
- sv_catpvn(PL_linestr, "\\", 1);
- sv_catpvn(PL_linestr, s, 1);
- }
- Perl_sv_catpvf(aTHX_ PL_linestr, "%c);", delim);
+ /* "q\0${splitstr}\0" is legal perl. Yes, even NUL
+ bytes can be used as quoting characters. :-) */
+ Perl_sv_catpvf(aTHX_ PL_linestr,
+ "our @F=split(q%c%s%c);",
+ 0, PL_splitstr, 0);
}
}
else
sv_catpv(PL_linestr,"our @F=split(' ');");
}
}
- sv_catpv(PL_linestr, "\n");
+ sv_catpvn(PL_linestr, "\n", 1);
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
PL_doextract = FALSE;
}
if (!PL_in_eval && (PL_minus_n || PL_minus_p)) {
- sv_setpv(PL_linestr,PL_minus_p ? ";}continue{print" : "");
- sv_catpv(PL_linestr,";}");
+ sv_setpv(PL_linestr,PL_minus_p
+ ? ";}continue{print;}" : ";}");
PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = Nullch;
PL_expect = XTERM; /* e.g. print $fh 3 */
else if (*s == '.' && isDIGIT(s[1]))
PL_expect = XTERM; /* e.g. print $fh .3 */
- else if (strchr("?-+", *s) && !isSPACE(s[1]) && s[1] != '=')
+ else if ((*s == '?' || *s == '-' || *s == '+')
+ && !isSPACE(s[1]) && s[1] != '=')
PL_expect = XTERM; /* e.g. print $fh -1 */
else if (*s == '/' && !isSPACE(s[1]) && s[1] != '=' && s[1] != '/')
PL_expect = XTERM; /* e.g. print $fh /.../
char *proto = SvPV((SV*)cv, len);
if (!len)
TERM(FUNC0SUB);
- if (strEQ(proto, "$"))
+ if (*proto == '$' && proto[1] == '\0')
OPERATOR(UNIOPSUB);
while (*proto == ';')
proto++;
}
safe_bareword:
- if (lastchar && strchr("*%&", lastchar) && ckWARN_d(WARN_AMBIGUOUS)) {
+ if ((lastchar == '*' || lastchar == '%' || lastchar == '&')
+ && ckWARN_d(WARN_AMBIGUOUS)) {
Perl_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Operator or semicolon missing before %c%s",
lastchar, PL_tokenbuf);
else if (*d == 'l') {
if (strEQ(d,"login")) return -KEY_getlogin;
}
- else if (strEQ(d,"c")) return -KEY_getc;
+ else if (*d == 'c' && d[1] == '\0') return -KEY_getc;
break;
}
switch (len) {
}
break;
case 'q':
- if (len <= 2) {
- if (strEQ(d,"q")) return KEY_q;
- if (strEQ(d,"qr")) return KEY_qr;
- if (strEQ(d,"qq")) return KEY_qq;
- if (strEQ(d,"qw")) return KEY_qw;
- if (strEQ(d,"qx")) return KEY_qx;
+ if (len == 1) {
+ return KEY_q;
+ }
+ else if (len == 2) {
+ switch (d[1]) {
+ case 'r': return KEY_qr;
+ case 'q': return KEY_qq;
+ case 'w': return KEY_qw;
+ case 'x': return KEY_qx;
+ };
}
else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
break;
return s;
}
if (*s == '$' && s[1] &&
- (isALNUM_lazy_if(s+1,UTF) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
+ (isALNUM_lazy_if(s+1,UTF) || s[1] == '$' || s[1] == '{' || strnEQ(s+1,"::",2)) )
{
return s;
}
}
complement = del = squash = 0;
- while (strchr("cds", *s)) {
- if (*s == 'c')
+ while (1) {
+ switch (*s) {
+ case 'c':
complement = OPpTRANS_COMPLEMENT;
- else if (*s == 'd')
+ break;
+ case 'd':
del = OPpTRANS_DELETE;
- else if (*s == 's')
+ break;
+ case 's':
squash = OPpTRANS_SQUASH;
+ break;
+ default:
+ goto no_more;
+ }
s++;
}
+ no_more:
New(803, tbl, complement&&!del?258:256, short);
o = newPVOP(OP_TRANS, 0, (char*)tbl);
if (!outer)
*d++ = '\n';
for (peek = s; SPACE_OR_TAB(*peek); peek++) ;
- if (*peek && strchr("`'\"",*peek)) {
+ if (*peek == '`' || *peek == '\'' || *peek =='"') {
s = peek;
term = *s++;
s = delimcpy(d, e, s, PL_bufend, term, &len);
}
/* read exponent part, if present */
- if (*s && strchr("eE",*s) && strchr("+-0123456789_", s[1])) {
+ if ((*s == 'e' || *s == 'E') && strchr("+-0123456789_", s[1])) {
floatit = TRUE;
s++;
https://perl5.git.perl.org / perl5.git / blobdiff