/* 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.
#define LEX_FORMLINE 1
#define LEX_KNOWNEXT 0
+#ifdef DEBUGGING
+static char* lex_state_names[] = {
+ "KNOWNEXT",
+ "FORMLINE",
+ "INTERPCONST",
+ "INTERPCONCAT",
+ "INTERPENDMAYBE",
+ "INTERPEND",
+ "INTERPSTART",
+ "INTERPPUSH",
+ "INTERPCASEMOD",
+ "INTERPNORMAL",
+ "NORMAL"
+};
+#endif
+
#ifdef ff_next
#undef ff_next
#endif
* Also see LOP and lop() below.
*/
-/* Note that REPORT() and REPORT2() will be expressions that supply
- * their own trailing comma, not suitable for statements as such. */
#ifdef DEBUGGING /* Serve -DT. */
-# define REPORT(x,retval) tokereport(x,s,(int)retval),
-# define REPORT2(x,retval) tokereport(x,s, yylval.ival),
+# define REPORT(retval) tokereport(s,(int)retval)
#else
-# define REPORT(x,retval)
-# define REPORT2(x,retval)
+# define REPORT(retval) (retval)
#endif
-#define TOKEN(retval) return (REPORT2("token",retval) PL_bufptr = s,(int)retval)
-#define OPERATOR(retval) return (REPORT2("operator",retval) PL_expect = XTERM, PL_bufptr = s,(int)retval)
-#define AOPERATOR(retval) return ao((REPORT2("aop",retval) PL_expect = XTERM, PL_bufptr = s,(int)retval))
-#define PREBLOCK(retval) return (REPORT2("preblock",retval) PL_expect = XBLOCK,PL_bufptr = s,(int)retval)
-#define PRETERMBLOCK(retval) return (REPORT2("pretermblock",retval) PL_expect = XTERMBLOCK,PL_bufptr = s,(int)retval)
-#define PREREF(retval) return (REPORT2("preref",retval) PL_expect = XREF,PL_bufptr = s,(int)retval)
-#define TERM(retval) return (CLINE, REPORT2("term",retval) PL_expect = XOPERATOR, PL_bufptr = s,(int)retval)
-#define LOOPX(f) return(yylval.ival=f, REPORT("loopx",f) PL_expect = XTERM,PL_bufptr = s,(int)LOOPEX)
-#define FTST(f) return(yylval.ival=f, REPORT("ftst",f) PL_expect = XTERMORDORDOR,PL_bufptr = s,(int)UNIOP)
-#define FUN0(f) return(yylval.ival = f, REPORT("fun0",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC0)
-#define FUN1(f) return(yylval.ival = f, REPORT("fun1",f) PL_expect = XOPERATOR,PL_bufptr = s,(int)FUNC1)
-#define BOop(f) return ao((yylval.ival=f, REPORT("bitorop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITOROP))
-#define BAop(f) return ao((yylval.ival=f, REPORT("bitandop",f) PL_expect = XTERM,PL_bufptr = s,(int)BITANDOP))
-#define SHop(f) return ao((yylval.ival=f, REPORT("shiftop",f) PL_expect = XTERM,PL_bufptr = s,(int)SHIFTOP))
-#define PWop(f) return ao((yylval.ival=f, REPORT("powop",f) PL_expect = XTERM,PL_bufptr = s,(int)POWOP))
-#define PMop(f) return(yylval.ival=f, REPORT("matchop",f) PL_expect = XTERM,PL_bufptr = s,(int)MATCHOP)
-#define Aop(f) return ao((yylval.ival=f, REPORT("add",f) PL_expect = XTERM,PL_bufptr = s,(int)ADDOP))
-#define Mop(f) return ao((yylval.ival=f, REPORT("mul",f) PL_expect = XTERM,PL_bufptr = s,(int)MULOP))
-#define Eop(f) return(yylval.ival=f, REPORT("eq",f) PL_expect = XTERM,PL_bufptr = s,(int)EQOP)
-#define Rop(f) return(yylval.ival=f, REPORT("rel",f) PL_expect = XTERM,PL_bufptr = s,(int)RELOP)
+#define TOKEN(retval) return ( PL_bufptr = s, REPORT(retval))
+#define OPERATOR(retval) return (PL_expect = XTERM, PL_bufptr = s, REPORT(retval))
+#define AOPERATOR(retval) return ao((PL_expect = XTERM, PL_bufptr = s, REPORT(retval)))
+#define PREBLOCK(retval) return (PL_expect = XBLOCK,PL_bufptr = s, REPORT(retval))
+#define PRETERMBLOCK(retval) return (PL_expect = XTERMBLOCK,PL_bufptr = s, REPORT(retval))
+#define PREREF(retval) return (PL_expect = XREF,PL_bufptr = s, REPORT(retval))
+#define TERM(retval) return (CLINE, PL_expect = XOPERATOR, PL_bufptr = s, REPORT(retval))
+#define LOOPX(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)LOOPEX))
+#define FTST(f) return (yylval.ival=f, PL_expect=XTERMORDORDOR, PL_bufptr=s, REPORT((int)UNIOP))
+#define FUN0(f) return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC0))
+#define FUN1(f) return (yylval.ival=f, PL_expect=XOPERATOR, PL_bufptr=s, REPORT((int)FUNC1))
+#define BOop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITOROP)))
+#define BAop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)BITANDOP)))
+#define SHop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)SHIFTOP)))
+#define PWop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)POWOP)))
+#define PMop(f) return(yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP))
+#define Aop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)ADDOP)))
+#define Mop(f) return ao((yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MULOP)))
+#define Eop(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)EQOP))
+#define Rop(f) return (yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)RELOP))
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
* The UNIDOR macro is for unary functions that can be followed by the //
* operator (such as C<shift // 0>).
*/
-#define UNI2(f,x) return(yylval.ival = f, \
- REPORT("uni",f) \
+#define UNI2(f,x) return ( \
+ yylval.ival = f, \
PL_expect = x, \
PL_bufptr = s, \
PL_last_uni = PL_oldbufptr, \
PL_last_lop_op = f, \
- (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+ REPORT( \
+ (*s == '(' || (s = skipspace(s), *s == '(') \
+ ? (int)FUNC1 : (int)UNIOP)))
#define UNI(f) UNI2(f,XTERM)
#define UNIDOR(f) UNI2(f,XTERMORDORDOR)
-#define UNIBRACK(f) return(yylval.ival = f, \
- REPORT("uni",f) \
+#define UNIBRACK(f) return ( \
+ yylval.ival = f, \
PL_bufptr = s, \
PL_last_uni = PL_oldbufptr, \
- (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
+ REPORT( \
+ (*s == '(' || (s = skipspace(s), *s == '(') \
+ ? (int)FUNC1 : (int)UNIOP)))
/* grandfather return to old style */
#define OLDLOP(f) return(yylval.ival=f,PL_expect = XTERM,PL_bufptr = s,(int)LSTOP)
#ifdef DEBUGGING
-STATIC void
-S_tokereport(pTHX_ char *thing, char* s, I32 rv)
+/* how to interpret the yylval associated with the token */
+enum token_type {
+ TOKENTYPE_NONE,
+ TOKENTYPE_IVAL,
+ TOKENTYPE_OPNUM, /* yylval.ival contains an opcode number */
+ TOKENTYPE_PVAL,
+ TOKENTYPE_OPVAL,
+ TOKENTYPE_GVVAL
+};
+
+static struct debug_tokens { int token, type; char *name;} debug_tokens[] =
{
- DEBUG_T({
- SV* report = newSVpv(thing, 0);
- Perl_sv_catpvf(aTHX_ report, ":line %d:%"IVdf":", CopLINE(PL_curcop),
- (IV)rv);
+ { ADDOP, TOKENTYPE_OPNUM, "ADDOP" },
+ { ANDAND, TOKENTYPE_NONE, "ANDAND" },
+ { ANDOP, TOKENTYPE_NONE, "ANDOP" },
+ { ANONSUB, TOKENTYPE_IVAL, "ANONSUB" },
+ { ARROW, TOKENTYPE_NONE, "ARROW" },
+ { ASSIGNOP, TOKENTYPE_OPNUM, "ASSIGNOP" },
+ { BITANDOP, TOKENTYPE_OPNUM, "BITANDOP" },
+ { BITOROP, TOKENTYPE_OPNUM, "BITOROP" },
+ { COLONATTR, TOKENTYPE_NONE, "COLONATTR" },
+ { CONTINUE, TOKENTYPE_NONE, "CONTINUE" },
+ { DO, TOKENTYPE_NONE, "DO" },
+ { DOLSHARP, TOKENTYPE_NONE, "DOLSHARP" },
+ { DORDOR, TOKENTYPE_NONE, "DORDOR" },
+ { DOROP, TOKENTYPE_OPNUM, "DOROP" },
+ { DOTDOT, TOKENTYPE_IVAL, "DOTDOT" },
+ { ELSE, TOKENTYPE_NONE, "ELSE" },
+ { ELSIF, TOKENTYPE_IVAL, "ELSIF" },
+ { EQOP, TOKENTYPE_OPNUM, "EQOP" },
+ { FOR, TOKENTYPE_IVAL, "FOR" },
+ { FORMAT, TOKENTYPE_NONE, "FORMAT" },
+ { FUNC, TOKENTYPE_OPNUM, "FUNC" },
+ { FUNC0, TOKENTYPE_OPNUM, "FUNC0" },
+ { FUNC0SUB, TOKENTYPE_OPVAL, "FUNC0SUB" },
+ { FUNC1, TOKENTYPE_OPNUM, "FUNC1" },
+ { FUNCMETH, TOKENTYPE_OPVAL, "FUNCMETH" },
+ { HASHBRACK, TOKENTYPE_NONE, "HASHBRACK" },
+ { IF, TOKENTYPE_IVAL, "IF" },
+ { LABEL, TOKENTYPE_PVAL, "LABEL" },
+ { LOCAL, TOKENTYPE_IVAL, "LOCAL" },
+ { LOOPEX, TOKENTYPE_OPNUM, "LOOPEX" },
+ { LSTOP, TOKENTYPE_OPNUM, "LSTOP" },
+ { LSTOPSUB, TOKENTYPE_OPVAL, "LSTOPSUB" },
+ { MATCHOP, TOKENTYPE_OPNUM, "MATCHOP" },
+ { METHOD, TOKENTYPE_OPVAL, "METHOD" },
+ { MULOP, TOKENTYPE_OPNUM, "MULOP" },
+ { MY, TOKENTYPE_IVAL, "MY" },
+ { MYSUB, TOKENTYPE_NONE, "MYSUB" },
+ { NOAMP, TOKENTYPE_NONE, "NOAMP" },
+ { NOTOP, TOKENTYPE_NONE, "NOTOP" },
+ { OROP, TOKENTYPE_IVAL, "OROP" },
+ { OROR, TOKENTYPE_NONE, "OROR" },
+ { PACKAGE, TOKENTYPE_NONE, "PACKAGE" },
+ { PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" },
+ { POSTDEC, TOKENTYPE_NONE, "POSTDEC" },
+ { POSTINC, TOKENTYPE_NONE, "POSTINC" },
+ { POWOP, TOKENTYPE_OPNUM, "POWOP" },
+ { PREDEC, TOKENTYPE_NONE, "PREDEC" },
+ { PREINC, TOKENTYPE_NONE, "PREINC" },
+ { PRIVATEREF, TOKENTYPE_OPVAL, "PRIVATEREF" },
+ { REFGEN, TOKENTYPE_NONE, "REFGEN" },
+ { RELOP, TOKENTYPE_OPNUM, "RELOP" },
+ { SHIFTOP, TOKENTYPE_OPNUM, "SHIFTOP" },
+ { SUB, TOKENTYPE_NONE, "SUB" },
+ { THING, TOKENTYPE_OPVAL, "THING" },
+ { UMINUS, TOKENTYPE_NONE, "UMINUS" },
+ { UNIOP, TOKENTYPE_OPNUM, "UNIOP" },
+ { UNIOPSUB, TOKENTYPE_OPVAL, "UNIOPSUB" },
+ { UNLESS, TOKENTYPE_IVAL, "UNLESS" },
+ { UNTIL, TOKENTYPE_IVAL, "UNTIL" },
+ { USE, TOKENTYPE_IVAL, "USE" },
+ { WHILE, TOKENTYPE_IVAL, "WHILE" },
+ { WORD, TOKENTYPE_OPVAL, "WORD" },
+ { 0, TOKENTYPE_NONE, 0 }
+};
+
+/* dump the returned token in rv, plus any optional arg in yylval */
+STATIC int
+S_tokereport(pTHX_ char* s, I32 rv)
+{
+ if (DEBUG_T_TEST) {
+ char *name = Nullch;
+ enum token_type type = TOKENTYPE_NONE;
+ struct debug_tokens *p;
+ SV* report = newSVpvn("<== ", 4);
+
+ for (p = debug_tokens; p->token; p++) {
+ if (p->token == (int)rv) {
+ name = p->name;
+ type = p->type;
+ break;
+ }
+ }
+ if (name)
+ Perl_sv_catpv(aTHX_ report, name);
+ else if ((char)rv > ' ' && (char)rv < '~')
+ Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv);
+ else if (!rv)
+ Perl_sv_catpv(aTHX_ report, "EOF");
+ else
+ Perl_sv_catpvf(aTHX_ report, "?? %"IVdf, (IV)rv);
+ switch (type) {
+ case TOKENTYPE_NONE:
+ case TOKENTYPE_GVVAL: /* doesn't appear to be used */
+ break;
+ case TOKENTYPE_IVAL:
+ Perl_sv_catpvf(aTHX_ report, "(ival=%"IVdf")", yylval.ival);
+ break;
+ case TOKENTYPE_OPNUM:
+ Perl_sv_catpvf(aTHX_ report, "(ival=op_%s)",
+ PL_op_name[yylval.ival]);
+ break;
+ case TOKENTYPE_PVAL:
+ Perl_sv_catpvf(aTHX_ report, "(pval=\"%s\")", yylval.pval);
+ break;
+ case TOKENTYPE_OPVAL:
+ if (yylval.opval)
+ Perl_sv_catpvf(aTHX_ report, "(opval=op_%s)",
+ PL_op_name[yylval.opval->op_type]);
+ else
+ Perl_sv_catpv(aTHX_ report, "(opval=null)");
+ break;
+ }
+ Perl_sv_catpvf(aTHX_ report, " at line %d [", CopLINE(PL_curcop));
if (s - PL_bufptr > 0)
sv_catpvn(report, PL_bufptr, s - PL_bufptr);
else {
if (PL_oldbufptr && *PL_oldbufptr)
sv_catpv(report, PL_tokenbuf);
}
- PerlIO_printf(Perl_debug_log, "### %s\n", SvPV_nolen(report));
- });
+ PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen(report));
+ };
+ return (int)rv;
}
#endif
(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
{
yylval.ival = f;
CLINE;
- REPORT("lop", f)
PL_expect = x;
PL_bufptr = s;
PL_last_lop = PL_oldbufptr;
PL_last_lop_op = (OPCODE)f;
if (PL_nexttoke)
- return LSTOP;
+ return REPORT(LSTOP);
if (*s == '(')
- return FUNC;
+ return REPORT(FUNC);
s = skipspace(s);
if (*s == '(')
- return FUNC;
+ return REPORT(FUNC);
else
- return LSTOP;
+ return REPORT(LSTOP);
}
/*
}
}
+STATIC SV *
+S_newSV_maybe_utf8(pTHX_ const char *start, STRLEN len)
+{
+ SV *sv = newSVpvn(start,len);
+ if (UTF && !IN_BYTES && is_utf8_string((U8*)start, len))
+ SvUTF8_on(sv);
+ return sv;
+}
+
/*
* S_force_word
* When the lexer knows the next thing is a word (for instance, it has
PL_expect = XOPERATOR;
}
}
- PL_nextval[PL_nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(PL_tokenbuf,0));
+ PL_nextval[PL_nexttoke].opval
+ = (OP*)newSVOP(OP_CONST,0,
+ S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
PL_nextval[PL_nexttoke].opval->op_private |= OPpCONST_BARE;
- if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVOP*)PL_nextval[PL_nexttoke].opval)->op_sv);
force_next(token);
}
return s;
UV uv = utf8_to_uvchr((U8*)str, 0);
if (uv < 0x100) {
- U8 tmpbuf[UTF8_MAXLEN+1], *d;
+ U8 tmpbuf[UTF8_MAXBYTES+1], *d;
d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
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++;
}
-/* Invoke the n'th filter function for the current rsfp. */
+/* Invoke the idxth filter function for the current rsfp. */
+/* maxlen 0 = read one text line */
I32
Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
-
-
- /* 0 = read one text line */
{
filter_t funcp;
SV *datasv = NULL;
if (!PL_rsfp_filters)
return -1;
- if (idx > AvFILLp(PL_rsfp_filters)){ /* Any more filters? */
+ if (idx > AvFILLp(PL_rsfp_filters)) { /* Any more filters? */
/* Provide a default input filter to make life easy. */
/* Note that we append to the line. This is handy. */
DEBUG_P(PerlIO_printf(Perl_debug_log,
return SvCUR(buf_sv);
}
/* Skip this filter slot if filter has been deleted */
- if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef){
+ if ( (datasv = FILTER_DATA(idx)) == &PL_sv_undef) {
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: skipped (filter deleted)\n",
idx));
}
#endif
if (PL_rsfp_filters) {
-
if (!append)
SvCUR_set(sv, 0); /* start with empty line */
if (FILTER_READ(0, sv, 0) > 0)
int
Perl_yylex(pTHX)
{
- register char *s;
+ register char *s = PL_bufptr;
register char *d;
register I32 tmp;
STRLEN len;
bool bof = FALSE;
I32 orig_keyword = 0;
+ DEBUG_T( {
+ PerlIO_printf(Perl_debug_log, "### LEX_%s\n",
+ lex_state_names[PL_lex_state]);
+ } );
/* check if there's an identifier for us to look at */
if (PL_pending_ident)
- return S_pending_ident(aTHX);
+ return REPORT(S_pending_ident(aTHX));
/* no identifier pending identification */
"### Next token after '%s' was known, type %"IVdf"\n", PL_bufptr,
(IV)PL_nexttype[PL_nexttoke]); });
- return(PL_nexttype[PL_nexttoke]);
+ return REPORT(PL_nexttype[PL_nexttoke]);
/* interpolated case modifiers like \L \U, including \Q and \E.
when we get here, PL_bufptr is at the \
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;
}
- return ')';
+ return REPORT(')');
}
if (PL_bufptr != PL_bufend)
PL_bufptr += 2;
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 ')';
+ return REPORT(')');
}
if (PL_lex_casemods > 10)
Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
if (PL_lex_starts) {
s = PL_bufptr;
PL_lex_starts = 0;
- Aop(OP_CONCAT);
+ /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
+ if (PL_lex_casemods == 1 && PL_lex_inpat)
+ OPERATOR(',');
+ else
+ Aop(OP_CONCAT);
}
else
return yylex();
}
case LEX_INTERPPUSH:
- return sublex_push();
+ return REPORT(sublex_push());
case LEX_INTERPSTART:
if (PL_bufptr == PL_bufend)
- return sublex_done();
+ return REPORT(sublex_done());
DEBUG_T({ PerlIO_printf(Perl_debug_log,
"### Interpolated variable at '%s'\n", PL_bufptr); });
PL_expect = XTERM;
}
if (PL_lex_starts++) {
s = PL_bufptr;
- Aop(OP_CONCAT);
+ /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
+ if (!PL_lex_casemods && PL_lex_inpat)
+ OPERATOR(',');
+ else
+ Aop(OP_CONCAT);
}
return yylex();
if (PL_lex_dojoin) {
PL_lex_dojoin = FALSE;
PL_lex_state = LEX_INTERPCONCAT;
- return ')';
+ return REPORT(')');
}
if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl
&& SvEVALED(PL_lex_repl))
Perl_croak(aTHX_ "panic: INTERPCONCAT");
#endif
if (PL_bufptr == PL_bufend)
- return sublex_done();
+ return REPORT(sublex_done());
if (SvIVX(PL_linestr) == '\'') {
SV *sv = newSVsv(PL_linestr);
PL_nextval[PL_nexttoke] = yylval;
PL_expect = XTERM;
force_next(THING);
- if (PL_lex_starts++)
- Aop(OP_CONCAT);
+ if (PL_lex_starts++) {
+ /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */
+ if (!PL_lex_casemods && PL_lex_inpat)
+ OPERATOR(',');
+ else
+ Aop(OP_CONCAT);
+ }
else {
PL_bufptr = s;
return yylex();
PL_oldoldbufptr = PL_oldbufptr;
PL_oldbufptr = s;
DEBUG_T( {
- PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at %s\n",
+ PerlIO_printf(Perl_debug_log, "### Tokener expecting %s at [%s]\n",
exp_name[PL_expect], s);
} );
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++) {
+ /* "q\0${splitstr}\0" is legal perl. Yes, even NUL
+ bytes can be used as quoting characters. :-) */
+ /* The count here deliberately includes the NUL
+ that terminates the C string constant. This
+ embeds the opening NUL into the string. */
+ sv_catpvn(PL_linestr, "our @F=split(q", 15);
+ s = PL_splitstr;
+ do {
+ /* Need to \ \s */
if (*s == '\\')
- sv_catpvn(PL_linestr, "\\", 1);
+ sv_catpvn(PL_linestr, s, 1);
sv_catpvn(PL_linestr, s, 1);
- }
- Perl_sv_catpvf(aTHX_ PL_linestr, "%c);", delim);
+ } while (*s++);
+ /* This loop will embed the trailing NUL of
+ PL_linestr as the last thing it does before
+ terminating. */
+ sv_catpvn(PL_linestr, ");", 2);
}
}
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;
sv_setpv(PL_linestr,"");
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
- /* if it looks like the start of a BOM, check if it in fact is */
- else if (bof && (!*s || *(U8*)s == 0xEF || *(U8*)s >= 0xFE)) {
+ /* If it looks like the start of a BOM or raw UTF-16,
+ * check if it in fact is. */
+ else if (bof &&
+ (*s == 0 ||
+ *(U8*)s == 0xEF ||
+ *(U8*)s >= 0xFE ||
+ s[1] == 0)) {
#ifdef PERLIO_IS_STDIO
# ifdef __GNU_LIBRARY__
# if __GNU_LIBRARY__ == 1 /* Linux glibc5 */
* subroutine call (or a -bareword), then. */
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### '-%c' looked like a file test but was not\n",
- tmp);
+ (int) tmp);
} );
s = --PL_bufptr;
}
yyerror("Unterminated attribute parameter in attribute list");
if (attrs)
op_free(attrs);
- return 0; /* EOF indicator */
+ return REPORT(0); /* EOF indicator */
}
}
if (PL_lex_stuff) {
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
depcom();
- return ','; /* grandfather non-comma-format format */
+ return REPORT(','); /* grandfather non-comma-format format */
}
}
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 /.../
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
depcom();
- return ','; /* grandfather non-comma-format format */
+ return REPORT(','); /* grandfather non-comma-format format */
}
else
no_op("String",s);
if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack) {
PL_expect = XTERM;
depcom();
- return ','; /* grandfather non-comma-format format */
+ return REPORT(','); /* grandfather non-comma-format format */
}
else
no_op("String",s);
/* Is this a word before a => operator? */
if (*d == '=' && d[1] == '>') {
CLINE;
- yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(PL_tokenbuf,0));
+ yylval.opval
+ = (OP*)newSVOP(OP_CONST, 0,
+ S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
yylval.opval->op_private = OPpCONST_BARE;
- if (UTF && !IN_BYTES && is_utf8_string((U8*)PL_tokenbuf, len))
- SvUTF8_on(((SVOP*)yylval.opval)->op_sv);
TERM(WORD);
}
{
tmp = 0; /* any sub overrides "weak" keyword */
}
+ else if (gv && !gvp
+ && tmp == -KEY_err
+ && GvCVu(gv)
+ && PL_expect != XOPERATOR
+ && PL_expect != XTERMORDORDOR)
+ {
+ /* any sub overrides the "err" keyword, except when really an
+ * operator is expected */
+ tmp = 0;
+ }
else { /* no override */
tmp = -tmp;
if (tmp == KEY_dump && ckWARN(WARN_MISC)) {
sv = newSVpvn("CORE::GLOBAL::",14);
sv_catpv(sv,PL_tokenbuf);
}
- else
- sv = newSVpv(PL_tokenbuf,0);
+ else {
+ /* If len is 0, newSVpv does strlen(), which is correct.
+ If len is non-zero, then it will be the true length,
+ and so the scalar will be created correctly. */
+ sv = newSVpv(PL_tokenbuf,len);
+ }
/* Presume this is going to be a bareword of some sort. */
/* Two barewords in a row may indicate method call. */
if ((isIDFIRST_lazy_if(s,UTF) || *s == '$') && (tmp=intuit_method(s,gv)))
- return tmp;
+ return REPORT(tmp);
/* If not a declared subroutine, it's an indirect object. */
/* (But it's an indir obj regardless for sort.) */
if (!orig_keyword
&& (isIDFIRST_lazy_if(s,UTF) || *s == '$')
&& (tmp = intuit_method(s,gv)))
- return tmp;
+ return REPORT(tmp);
/* Not a method, so call it a subroutine (if defined) */
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);
case KEY___PACKAGE__:
yylval.opval = (OP*)newSVOP(OP_CONST, 0,
(PL_curstash
- ? newSVsv(PL_curstname)
+ ? newSVpv(HvNAME(PL_curstash), 0)
: &PL_sv_undef));
TERM(THING);
if (*s == ':' && s[1] != ':')
PL_expect = attrful;
- else if (!have_name && *s != '{' && key == KEY_sub)
- Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
+ else if (*s != '{' && key == KEY_sub) {
+ if (!have_name)
+ Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
+ else if (*s != ';')
+ Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, PL_subname);
+ }
if (have_proto) {
PL_nextval[PL_nexttoke].opval =
sv_catpv(sym, PL_tokenbuf+1);
yylval.opval = (OP*)newSVOP(OP_CONST, 0, sym);
yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpv(SvPVX(sym),
+ gv_fetchsv(sym,
(PL_in_eval
? (GV_ADDMULTI | GV_ADDINEVAL)
: GV_ADDMULTI
return WORD;
}
+/* Weights are the number of occurrences of that keyword in about 135M of
+ input to Perl_keyword from a lot of real perl. This routine is about 20%
+ faster than the routine it replaces. */
+
I32
-Perl_keyword(pTHX_ register char *d, I32 len)
-{
- switch (*d) {
- case '_':
- if (d[1] == '_') {
- 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__;
- }
- break;
- case 'A':
- if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
- break;
+Perl_keyword (pTHX_ char *name, I32 len) {
+ /* Initially switch on the length of the name. */
+ switch (len) {
+ case 1:
+ /* Names all of length 1. */
+ /* m q s x y */
+ /* Offset 0 gives the best switch position. */
+ switch (name[0]) {
+ case 'm':
+ {
+ return KEY_m; /* Weight 148776 */
+ }
+ break;
+ case 'q':
+ {
+ return KEY_q; /* Weight 69076 */
+ }
+ break;
+ case 's':
+ {
+ return KEY_s; /* Weight 403691 */
+ }
+ break;
+ case 'x':
+ {
+ return -KEY_x; /* Weight 38549 */
+ }
+ break;
+ case 'y':
+ {
+ return KEY_y; /* Weight 567 */
+ }
+ break;
+ }
+ break;
+ case 2:
+ /* Names all of length 2. */
+ /* do eq ge gt if lc le lt my ne no or qq qr qw qx tr uc */
+ /* Offset 0 gives the best switch position. */
+ switch (name[0]) {
+ case 'd':
+ if (name[1] == 'o') {
+ return KEY_do; /* Weight 96004 */
+ }
+ break;
+ case 'e':
+ if (name[1] == 'q') {
+ return -KEY_eq; /* Weight 797065 */
+ }
+ break;
+ case 'g':
+ if (name[1] == 'e') {
+ return -KEY_ge; /* Weight 5666 */
+ }
+ if (name[1] == 't') {
+ return -KEY_gt; /* Weight 897 */
+ }
+ break;
+ case 'i':
+ if (name[1] == 'f') {
+ return KEY_if; /* Weight 2482605 */
+ }
+ break;
+ case 'l':
+ if (name[1] == 'c') {
+ return -KEY_lc; /* Weight 38487 */
+ }
+ if (name[1] == 'e') {
+ return -KEY_le; /* Weight 4052 */
+ }
+ if (name[1] == 't') {
+ return -KEY_lt; /* Weight 335 */
+ }
+ break;
+ case 'm':
+ if (name[1] == 'y') {
+ return KEY_my; /* Weight 3785925 */
+ }
+ break;
+ case 'n':
+ if (name[1] == 'e') {
+ return -KEY_ne; /* Weight 112906 */
+ }
+ if (name[1] == 'o') {
+ return KEY_no; /* Weight 61989 */
+ }
+ break;
+ case 'o':
+ if (name[1] == 'r') {
+ return -KEY_or; /* Weight 405163 */
+ }
+ break;
+ case 'q':
+ if (name[1] == 'w') {
+ return KEY_qw; /* Weight 415641 */
+ }
+ if (name[1] == 'q') {
+ return KEY_qq; /* Weight 55149 */
+ }
+ if (name[1] == 'r') {
+ return KEY_qr; /* Weight 28519 */
+ }
+ if (name[1] == 'x') {
+ return KEY_qx; /* Weight 177 */
+ }
+ break;
+ case 't':
+ if (name[1] == 'r') {
+ return KEY_tr; /* Weight 22665 */
+ }
+ break;
+ case 'u':
+ if (name[1] == 'c') {
+ return -KEY_uc; /* Weight 16961 */
+ }
+ break;
+ }
+ break;
+ case 3:
+ /* Names all of length 3. */
+ /* END abs and chr cmp cos die eof err exp for hex int log map not oct ord
+ our pop pos ref sin sub tie use vec xor */
+ /* Offset 0 gives the best switch position. */
+ switch (*name++) {
+ case 'E':
+ if (name[0] == 'N' && name[1] == 'D') {
+ return KEY_END; /* Weight 3565 */
+ }
+ break;
case 'a':
- switch (len) {
- case 3:
- 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;
- break;
- case 6:
- if (strEQ(d,"accept")) return -KEY_accept;
- break;
- }
- break;
- case 'B':
- if (strEQ(d,"BEGIN")) return KEY_BEGIN;
- break;
+ if (name[0] == 'n' && name[1] == 'd') {
+ return -KEY_and; /* Weight 284867 */
+ }
+ if (name[0] == 'b' && name[1] == 's') {
+ return -KEY_abs; /* Weight 7767 */
+ }
+ break;
+ case 'c':
+ if (name[0] == 'h' && name[1] == 'r') {
+ return -KEY_chr; /* Weight 35654 */
+ }
+ if (name[0] == 'm' && name[1] == 'p') {
+ return -KEY_cmp; /* Weight 6808 */
+ }
+ if (name[0] == 'o' && name[1] == 's') {
+ return -KEY_cos; /* Weight 447 */
+ }
+ break;
+ case 'd':
+ if (name[0] == 'i' && name[1] == 'e') {
+ return -KEY_die; /* Weight 192203 */
+ }
+ break;
+ case 'e':
+ if (name[0] == 'o' && name[1] == 'f') {
+ return -KEY_eof; /* Weight 1618 */
+ }
+ if (name[0] == 'r' && name[1] == 'r') {
+ return -KEY_err; /* Weight 522 */
+ }
+ if (name[0] == 'x' && name[1] == 'p') {
+ return -KEY_exp; /* Weight 423 */
+ }
+ break;
+ case 'f':
+ if (name[0] == 'o' && name[1] == 'r') {
+ return KEY_for; /* Weight 118158 */
+ }
+ break;
+ case 'h':
+ if (name[0] == 'e' && name[1] == 'x') {
+ return -KEY_hex; /* Weight 3629 */
+ }
+ break;
+ case 'i':
+ if (name[0] == 'n' && name[1] == 't') {
+ return -KEY_int; /* Weight 18549 */
+ }
+ break;
+ case 'l':
+ if (name[0] == 'o' && name[1] == 'g') {
+ return -KEY_log;
+ }
+ break;
+ case 'm':
+ if (name[0] == 'a' && name[1] == 'p') {
+ return KEY_map; /* Weight 115207 */
+ }
+ break;
+ case 'n':
+ if (name[0] == 'o' && name[1] == 't') {
+ return -KEY_not; /* Weight 55868 */
+ }
+ break;
+ case 'o':
+ if (name[0] == 'u' && name[1] == 'r') {
+ return KEY_our; /* Weight 194417 */
+ }
+ if (name[0] == 'r' && name[1] == 'd') {
+ return -KEY_ord; /* Weight 22221 */
+ }
+ if (name[0] == 'c' && name[1] == 't') {
+ return -KEY_oct; /* Weight 4195 */
+ }
+ break;
+ case 'p':
+ if (name[0] == 'o' && name[1] == 'p') {
+ return -KEY_pop; /* Weight 46933 */
+ }
+ if (name[0] == 'o' && name[1] == 's') {
+ return KEY_pos; /* Weight 5503 */
+ }
+ break;
+ case 'r':
+ if (name[0] == 'e' && name[1] == 'f') {
+ return -KEY_ref; /* Weight 347102 */
+ }
+ break;
+ case 's':
+ if (name[0] == 'u' && name[1] == 'b') {
+ return KEY_sub; /* Weight 2053554 */
+ }
+ if (name[0] == 'i' && name[1] == 'n') {
+ return -KEY_sin; /* Weight 499 */
+ }
+ break;
+ case 't':
+ if (name[0] == 'i' && name[1] == 'e') {
+ return KEY_tie; /* Weight 10131 */
+ }
+ break;
+ case 'u':
+ if (name[0] == 's' && name[1] == 'e') {
+ return KEY_use; /* Weight 686081 */
+ }
+ break;
+ case 'v':
+ if (name[0] == 'e' && name[1] == 'c') {
+ return -KEY_vec; /* Weight 110566 */
+ }
+ break;
+ case 'x':
+ if (name[0] == 'o' && name[1] == 'r') {
+ return -KEY_xor; /* Weight 619 */
+ }
+ break;
+ }
+ break;
+ case 4:
+ /* Names all of length 4. */
+ /* CORE INIT bind chop dump each else eval exec exit fork getc glob goto
+ grep join keys kill last link lock next open pack pipe push rand read
+ recv redo seek send sort sqrt stat tell tied time wait warn */
+ /* Offset 0 gives the best switch position. */
+ switch (*name++) {
+ case 'C':
+ if (!memcmp(name, "ORE", 3)) {
+ /* C */
+ return -KEY_CORE; /* Weight 47391 */
+ }
+ break;
+ case 'I':
+ if (!memcmp(name, "NIT", 3)) {
+ /* I */
+ return KEY_INIT; /* Weight 418 */
+ }
+ break;
case 'b':
- if (strEQ(d,"bless")) return -KEY_bless;
- if (strEQ(d,"bind")) return -KEY_bind;
- if (strEQ(d,"binmode")) return -KEY_binmode;
- break;
+ if (!memcmp(name, "ind", 3)) {
+ /* b */
+ return -KEY_bind; /* Weight 290 */
+ }
+ break;
+ case 'c':
+ if (!memcmp(name, "hop", 3)) {
+ /* c */
+ return -KEY_chop; /* Weight 10172 */
+ }
+ break;
+ case 'd':
+ if (!memcmp(name, "ump", 3)) {
+ /* d */
+ return -KEY_dump; /* Weight 274 */
+ }
+ break;
+ case 'e':
+ if (!memcmp(name, "lse", 3)) {
+ /* e */
+ return KEY_else; /* Weight 527806 */
+ }
+ if (!memcmp(name, "val", 3)) {
+ /* e */
+ return KEY_eval; /* Weight 136977 */
+ }
+ if (!memcmp(name, "ach", 3)) {
+ /* e */
+ return -KEY_each; /* Weight 18414 */
+ }
+ if (!memcmp(name, "xit", 3)) {
+ /* e */
+ return -KEY_exit; /* Weight 8262 */
+ }
+ if (!memcmp(name, "xec", 3)) {
+ /* e */
+ return -KEY_exec; /* Weight 429 */
+ }
+ break;
+ case 'f':
+ if (!memcmp(name, "ork", 3)) {
+ /* f */
+ return -KEY_fork; /* Weight 327 */
+ }
+ break;
+ case 'g':
+ if (!memcmp(name, "oto", 3)) {
+ /* g */
+ return KEY_goto; /* Weight 109258 */
+ }
+ if (!memcmp(name, "rep", 3)) {
+ /* g */
+ return KEY_grep; /* Weight 75912 */
+ }
+ if (!memcmp(name, "lob", 3)) {
+ /* g */
+ return KEY_glob; /* Weight 2172 */
+ }
+ if (!memcmp(name, "etc", 3)) {
+ /* g */
+ return -KEY_getc; /* Weight 981 */
+ }
+ break;
+ case 'j':
+ if (!memcmp(name, "oin", 3)) {
+ /* j */
+ return -KEY_join; /* Weight 130820 */
+ }
+ break;
+ case 'k':
+ if (!memcmp(name, "eys", 3)) {
+ /* k */
+ return -KEY_keys; /* Weight 131427 */
+ }
+ if (!memcmp(name, "ill", 3)) {
+ /* k */
+ return -KEY_kill; /* Weight 382 */
+ }
+ break;
+ case 'l':
+ if (!memcmp(name, "ast", 3)) {
+ /* l */
+ return KEY_last; /* Weight 95078 */
+ }
+ if (!memcmp(name, "ock", 3)) {
+ /* l */
+ return -KEY_lock; /* Weight 4210 */
+ }
+ if (!memcmp(name, "ink", 3)) {
+ /* l */
+ return -KEY_link; /* Weight 425 */
+ }
+ break;
+ case 'n':
+ if (!memcmp(name, "ext", 3)) {
+ /* n */
+ return KEY_next; /* Weight 153355 */
+ }
+ break;
+ case 'o':
+ if (!memcmp(name, "pen", 3)) {
+ /* o */
+ return -KEY_open; /* Weight 39060 */
+ }
+ break;
+ case 'p':
+ if (!memcmp(name, "ush", 3)) {
+ /* p */
+ return -KEY_push; /* Weight 256975 */
+ }
+ if (!memcmp(name, "ack", 3)) {
+ /* p */
+ return -KEY_pack; /* Weight 14491 */
+ }
+ if (!memcmp(name, "ipe", 3)) {
+ /* p */
+ return -KEY_pipe; /* Weight 344 */
+ }
+ break;
+ case 'r':
+ if (!memcmp(name, "ead", 3)) {
+ /* r */
+ return -KEY_read; /* Weight 9434 */
+ }
+ if (!memcmp(name, "edo", 3)) {
+ /* r */
+ return KEY_redo; /* Weight 5219 */
+ }
+ if (!memcmp(name, "and", 3)) {
+ /* r */
+ return -KEY_rand; /* Weight 1824 */
+ }
+ if (!memcmp(name, "ecv", 3)) {
+ /* r */
+ return -KEY_recv; /* Weight 250 */
+ }
+ break;
+ case 's':
+ if (!memcmp(name, "tat", 3)) {
+ /* s */
+ return -KEY_stat; /* Weight 36702 */
+ }
+ if (!memcmp(name, "ort", 3)) {
+ /* s */
+ return KEY_sort; /* Weight 36394 */
+ }
+ if (!memcmp(name, "eek", 3)) {
+ /* s */
+ return -KEY_seek; /* Weight 2174 */
+ }
+ if (!memcmp(name, "qrt", 3)) {
+ /* s */
+ return -KEY_sqrt; /* Weight 766 */
+ }
+ if (!memcmp(name, "end", 3)) {
+ /* s */
+ return -KEY_send; /* Weight 496 */
+ }
+ break;
+ case 't':
+ if (!memcmp(name, "ime", 3)) {
+ /* t */
+ return -KEY_time; /* Weight 32168 */
+ }
+ if (!memcmp(name, "ied", 3)) {
+ /* t */
+ return KEY_tied; /* Weight 9749 */
+ }
+ if (!memcmp(name, "ell", 3)) {
+ /* t */
+ return -KEY_tell; /* Weight 2578 */
+ }
+ break;
+ case 'w':
+ if (!memcmp(name, "arn", 3)) {
+ /* w */
+ return -KEY_warn; /* Weight 91372 */
+ }
+ if (!memcmp(name, "ait", 3)) {
+ /* w */
+ return -KEY_wait;
+ }
+ break;
+ }
+ break;
+ case 5:
+ /* Names all of length 5. */
+ /* BEGIN CHECK alarm atan2 bless chdir chmod chomp chown close crypt elsif
+ fcntl flock index ioctl local lstat mkdir print reset rmdir semop shift
+ sleep split srand study times umask undef untie until utime while write
+ */
+ /* Offset 3 gives the best switch position. */
+ switch (name[3]) {
case 'C':
- if (strEQ(d,"CORE")) return -KEY_CORE;
- if (strEQ(d,"CHECK")) return KEY_CHECK;
- break;
+ if (!memcmp(name, "CHECK", 5)) {
+ /* ^ */
+ return KEY_CHECK; /* Weight 538 */
+ }
+ break;
+ case 'I':
+ if (!memcmp(name, "BEGIN", 5)) {
+ /* ^ */
+ return KEY_BEGIN; /* Weight 24125 */
+ }
+ break;
+ case 'a':
+ if (!memcmp(name, "local", 5)) {
+ /* ^ */
+ return KEY_local; /* Weight 262973 */
+ }
+ if (!memcmp(name, "lstat", 5)) {
+ /* ^ */
+ return -KEY_lstat; /* Weight 13859 */
+ }
+ 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;
- 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,"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;
- break;
- case 7:
- if (strEQ(d,"connect")) return -KEY_connect;
- break;
- case 8:
- if (strEQ(d,"closedir")) return -KEY_closedir;
- if (strEQ(d,"continue")) return -KEY_continue;
- break;
- }
- break;
- case 'D':
- if (strEQ(d,"DESTROY")) return KEY_DESTROY;
- break;
+ if (!memcmp(name, "flock", 5)) {
+ /* ^ */
+ return -KEY_flock; /* Weight 260 */
+ }
+ break;
case 'd':
- switch (len) {
- case 2:
- if (strEQ(d,"do")) return KEY_do;
- break;
- case 3:
- if (strEQ(d,"die")) return -KEY_die;
- break;
- case 4:
- 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;
- break;
- case 8:
- if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
- break;
- }
- break;
- case 'E':
- if (strEQ(d,"END")) return KEY_END;
- break;
+ if (!memcmp(name, "study", 5)) {
+ /* ^ */
+ return KEY_study; /* Weight 1933 */
+ }
+ break;
case 'e':
- switch (len) {
- case 2:
- if (strEQ(d,"eq")) return -KEY_eq;
- break;
- case 3:
- if (strEQ(d,"eof")) return -KEY_eof;
- if (strEQ(d,"err")) return -KEY_err;
- 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,"eval")) return KEY_eval;
- 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") && ckWARN_d(WARN_SYNTAX))
- Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "elseif should be elsif");
- break;
- case 8:
- if (strEQ(d,"endgrent")) return -KEY_endgrent;
- if (strEQ(d,"endpwent")) return -KEY_endpwent;
- break;
- case 9:
- if (strEQ(d,"endnetent")) return -KEY_endnetent;
- break;
- case 10:
- if (strEQ(d,"endhostent")) return -KEY_endhostent;
- if (strEQ(d,"endservent")) return -KEY_endservent;
- break;
- case 11:
- if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
- break;
- }
- break;
+ if (!memcmp(name, "undef", 5)) {
+ /* ^ */
+ return KEY_undef; /* Weight 311156 */
+ }
+ if (!memcmp(name, "index", 5)) {
+ /* ^ */
+ return -KEY_index; /* Weight 51465 */
+ }
+ if (!memcmp(name, "sleep", 5)) {
+ /* ^ */
+ return -KEY_sleep; /* Weight 519 */
+ }
+ if (!memcmp(name, "times", 5)) {
+ /* ^ */
+ return -KEY_times; /* Weight 310 */
+ }
+ if (!memcmp(name, "reset", 5)) {
+ /* ^ */
+ return -KEY_reset; /* Weight 127 */
+ }
+ break;
case 'f':
- switch (len) {
- case 3:
- if (strEQ(d,"for")) return KEY_for;
- break;
- case 4:
- if (strEQ(d,"fork")) return -KEY_fork;
- break;
- case 5:
- 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;
- break;
- case 7:
- if (strEQ(d,"foreach")) return KEY_foreach;
- break;
- case 8:
- if (strEQ(d,"formline")) return -KEY_formline;
- break;
- }
+ if (!memcmp(name, "shift", 5)) {
+ /* ^ */
+ return -KEY_shift; /* Weight 904125 */
+ }
+ break;
+ case 'i':
+ if (!memcmp(name, "elsif", 5)) {
+ /* ^ */
+ return KEY_elsif; /* Weight 322365 */
+ }
+ if (!memcmp(name, "split", 5)) {
+ /* ^ */
+ return KEY_split; /* Weight 93678 */
+ }
+ if (!memcmp(name, "chdir", 5)) {
+ /* ^ */
+ return -KEY_chdir; /* Weight 20317 */
+ }
+ if (!memcmp(name, "mkdir", 5)) {
+ /* ^ */
+ return -KEY_mkdir; /* Weight 2951 */
+ }
+ if (!memcmp(name, "rmdir", 5)) {
+ /* ^ */
+ return -KEY_rmdir; /* Weight 2493 */
+ }
+ if (!memcmp(name, "until", 5)) {
+ /* ^ */
+ return KEY_until; /* Weight 818 */
+ }
+ if (!memcmp(name, "untie", 5)) {
+ /* ^ */
+ return KEY_untie; /* Weight 420 */
+ }
+ break;
+ case 'l':
+ if (!memcmp(name, "while", 5)) {
+ /* ^ */
+ return KEY_while; /* Weight 120305 */
+ }
+ break;
+ case 'm':
+ if (!memcmp(name, "chomp", 5)) {
+ /* ^ */
+ return -KEY_chomp; /* Weight 22337 */
+ }
+ if (!memcmp(name, "utime", 5)) {
+ /* ^ */
+ return -KEY_utime; /* Weight 3849 */
+ }
+ break;
+ case 'n':
+ if (!memcmp(name, "print", 5)) {
+ /* ^ */
+ return KEY_print; /* Weight 220904 */
+ }
+ if (!memcmp(name, "atan2", 5)) {
+ /* ^ */
+ return -KEY_atan2; /* Weight 350 */
+ }
+ if (!memcmp(name, "srand", 5)) {
+ /* ^ */
+ return -KEY_srand; /* Weight 41 */
+ }
+ break;
+ case 'o':
+ if (!memcmp(name, "chmod", 5)) {
+ /* ^ */
+ return -KEY_chmod; /* Weight 18455 */
+ }
+ if (!memcmp(name, "semop", 5)) {
+ /* ^ */
+ return -KEY_semop;
+ }
+ break;
+ case 'p':
+ if (!memcmp(name, "crypt", 5)) {
+ /* ^ */
+ return -KEY_crypt; /* Weight 8 */
+ }
+ break;
+ case 'r':
+ if (!memcmp(name, "alarm", 5)) {
+ /* ^ */
+ return -KEY_alarm;
+ }
+ break;
+ case 's':
+ if (!memcmp(name, "bless", 5)) {
+ /* ^ */
+ return -KEY_bless; /* Weight 62111 */
+ }
+ if (!memcmp(name, "close", 5)) {
+ /* ^ */
+ return -KEY_close; /* Weight 44077 */
+ }
+ if (!memcmp(name, "umask", 5)) {
+ /* ^ */
+ return -KEY_umask; /* Weight 1658 */
+ }
+ break;
+ case 't':
+ if (!memcmp(name, "write", 5)) {
+ /* ^ */
+ return -KEY_write; /* Weight 2525 */
+ }
+ if (!memcmp(name, "fcntl", 5)) {
+ /* ^ */
+ return -KEY_fcntl; /* Weight 1257 */
+ }
+ if (!memcmp(name, "ioctl", 5)) {
+ /* ^ */
+ return -KEY_ioctl; /* Weight 967 */
+ }
+ break;
+ case 'w':
+ if (!memcmp(name, "chown", 5)) {
+ /* ^ */
+ return -KEY_chown; /* Weight 34 */
+ }
+ break;
+ }
+ break;
+ case 6:
+ /* Names all of length 6. */
+ /* accept caller chroot delete elseif exists fileno format gmtime length
+ listen msgctl msgget msgrcv msgsnd printf rename return rindex scalar
+ select semctl semget shmctl shmget socket splice substr system unless
+ unlink unpack values */
+ /* Offset 3 gives the best switch position. */
+ switch (name[3]) {
+ case 'a':
+ if (!memcmp(name, "unpack", 6)) {
+ /* ^ */
+ return -KEY_unpack; /* Weight 7849 */
+ }
+ if (!memcmp(name, "rename", 6)) {
+ /* ^ */
+ return -KEY_rename; /* Weight 4918 */
+ }
+ break;
+ case 'c':
+ if (!memcmp(name, "semctl", 6)) {
+ /* ^ */
+ return -KEY_semctl; /* Weight 17 */
+ }
+ if (!memcmp(name, "msgctl", 6)) {
+ /* ^ */
+ return -KEY_msgctl;
+ }
+ if (!memcmp(name, "shmctl", 6)) {
+ /* ^ */
+ return -KEY_shmctl;
+ }
+ break;
+ case 'd':
+ if (!memcmp(name, "rindex", 6)) {
+ /* ^ */
+ return -KEY_rindex; /* Weight 5005 */
+ }
+ break;
+ case 'e':
+ if (!memcmp(name, "unless", 6)) {
+ /* ^ */
+ return KEY_unless; /* Weight 913955 */
+ }
+ if (!memcmp(name, "delete", 6)) {
+ /* ^ */
+ return KEY_delete; /* Weight 74966 */
+ }
+ if (!memcmp(name, "select", 6)) {
+ /* ^ */
+ return -KEY_select; /* Weight 12209 */
+ }
+ if (!memcmp(name, "fileno", 6)) {
+ /* ^ */
+ return -KEY_fileno; /* Weight 8591 */
+ }
+ if (!memcmp(name, "accept", 6)) {
+ /* ^ */
+ return -KEY_accept; /* Weight 233 */
+ }
+ if (!memcmp(name, "elseif", 6)) {
+ /* ^ */
+ /* This is somewhat hacky. */
+ if(ckWARN_d(WARN_SYNTAX))
+ Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "elseif should be elsif");
break;
+ }
+ break;
case 'g':
- if (strnEQ(d,"get",3)) {
- d += 3;
- if (*d == 'p') {
- switch (len) {
- case 7:
- 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;
- break;
- case 11:
- 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;
- break;
- case 16:
- 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;
- }
- 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;
- }
- 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;
- }
- 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;
- }
- else if (*d == 'l') {
- if (strEQ(d,"login")) return -KEY_getlogin;
- }
- 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;
- break;
- case 4:
- if (strEQ(d,"grep")) return KEY_grep;
- if (strEQ(d,"goto")) return KEY_goto;
- if (strEQ(d,"glob")) return KEY_glob;
- break;
- case 6:
- if (strEQ(d,"gmtime")) return -KEY_gmtime;
- break;
- }
- break;
+ if (!memcmp(name, "length", 6)) {
+ /* ^ */
+ return -KEY_length; /* Weight 163975 */
+ }
+ if (!memcmp(name, "msgget", 6)) {
+ /* ^ */
+ return -KEY_msgget;
+ }
+ if (!memcmp(name, "semget", 6)) {
+ /* ^ */
+ return -KEY_semget;
+ }
+ if (!memcmp(name, "shmget", 6)) {
+ /* ^ */
+ return -KEY_shmget;
+ }
+ break;
+ case 'i':
+ if (!memcmp(name, "splice", 6)) {
+ /* ^ */
+ return -KEY_splice; /* Weight 25143 */
+ }
+ if (!memcmp(name, "unlink", 6)) {
+ /* ^ */
+ return -KEY_unlink; /* Weight 18616 */
+ }
+ if (!memcmp(name, "gmtime", 6)) {
+ /* ^ */
+ return -KEY_gmtime; /* Weight 4040 */
+ }
+ break;
+ case 'k':
+ if (!memcmp(name, "socket", 6)) {
+ /* ^ */
+ return -KEY_socket;
+ }
+ break;
+ case 'l':
+ if (!memcmp(name, "caller", 6)) {
+ /* ^ */
+ return -KEY_caller; /* Weight 148457 */
+ }
+ if (!memcmp(name, "scalar", 6)) {
+ /* ^ */
+ return KEY_scalar; /* Weight 43953 */
+ }
+ break;
+ case 'm':
+ if (!memcmp(name, "format", 6)) {
+ /* ^ */
+ return KEY_format; /* Weight 1735 */
+ }
+ break;
+ case 'n':
+ if (!memcmp(name, "printf", 6)) {
+ /* ^ */
+ return KEY_printf; /* Weight 6874 */
+ }
+ break;
+ case 'o':
+ if (!memcmp(name, "chroot", 6)) {
+ /* ^ */
+ return -KEY_chroot;
+ }
+ break;
+ case 'r':
+ if (!memcmp(name, "msgrcv", 6)) {
+ /* ^ */
+ return -KEY_msgrcv;
+ }
+ break;
+ case 's':
+ if (!memcmp(name, "exists", 6)) {
+ /* ^ */
+ return KEY_exists; /* Weight 145939 */
+ }
+ if (!memcmp(name, "substr", 6)) {
+ /* ^ */
+ return -KEY_substr; /* Weight 121344 */
+ }
+ if (!memcmp(name, "msgsnd", 6)) {
+ /* ^ */
+ return -KEY_msgsnd;
+ }
+ break;
+ case 't':
+ if (!memcmp(name, "system", 6)) {
+ /* ^ */
+ return -KEY_system; /* Weight 4326 */
+ }
+ if (!memcmp(name, "listen", 6)) {
+ /* ^ */
+ return -KEY_listen;
+ }
+ break;
+ case 'u':
+ if (!memcmp(name, "return", 6)) {
+ /* ^ */
+ return KEY_return; /* Weight 1401629 */
+ }
+ if (!memcmp(name, "values", 6)) {
+ /* ^ */
+ return -KEY_values; /* Weight 10110 */
+ }
+ break;
+ }
+ break;
+ case 7:
+ /* Names all of length 7. */
+ /* DESTROY __END__ binmode connect dbmopen defined foreach getpgrp getppid
+ lcfirst opendir package readdir require reverse seekdir setpgrp shmread
+ sprintf symlink syscall sysopen sysread sysseek telldir ucfirst unshift
+ waitpid */
+ /* Offset 3 gives the best switch position. */
+ switch (name[3]) {
+ case 'N':
+ if (!memcmp(name, "__END__", 7)) {
+ /* ^ */
+ return KEY___END__; /* Weight 112636 */
+ }
+ break;
+ case 'T':
+ if (!memcmp(name, "DESTROY", 7)) {
+ /* ^ */
+ return KEY_DESTROY; /* Weight 7 */
+ }
+ break;
+ case 'c':
+ if (!memcmp(name, "syscall", 7)) {
+ /* ^ */
+ return -KEY_syscall; /* Weight 560 */
+ }
+ break;
+ case 'd':
+ if (!memcmp(name, "readdir", 7)) {
+ /* ^ */
+ return -KEY_readdir; /* Weight 11716 */
+ }
+ break;
+ case 'e':
+ if (!memcmp(name, "foreach", 7)) {
+ /* ^ */
+ return KEY_foreach; /* Weight 281720 */
+ }
+ if (!memcmp(name, "reverse", 7)) {
+ /* ^ */
+ return -KEY_reverse; /* Weight 10571 */
+ }
+ break;
case 'h':
- if (strEQ(d,"hex")) return -KEY_hex;
- break;
- case 'I':
- if (strEQ(d,"INIT")) return KEY_INIT;
- break;
+ if (!memcmp(name, "unshift", 7)) {
+ /* ^ */
+ return -KEY_unshift; /* Weight 36504 */
+ }
+ break;
case 'i':
- switch (len) {
- case 2:
- if (strEQ(d,"if")) return KEY_if;
- break;
- case 3:
- if (strEQ(d,"int")) return -KEY_int;
- break;
- case 5:
- 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;
- break;
+ if (!memcmp(name, "defined", 7)) {
+ /* ^ */
+ return KEY_defined; /* Weight 694277 */
+ }
+ if (!memcmp(name, "sprintf", 7)) {
+ /* ^ */
+ return -KEY_sprintf; /* Weight 72704 */
+ }
+ if (!memcmp(name, "ucfirst", 7)) {
+ /* ^ */
+ return -KEY_ucfirst; /* Weight 1012 */
+ }
+ if (!memcmp(name, "lcfirst", 7)) {
+ /* ^ */
+ return -KEY_lcfirst; /* Weight 165 */
+ }
+ break;
case 'k':
- if (len == 4) {
- if (strEQ(d,"keys")) return -KEY_keys;
- if (strEQ(d,"kill")) return -KEY_kill;
- }
- break;
+ if (!memcmp(name, "package", 7)) {
+ /* ^ */
+ return KEY_package; /* Weight 245661 */
+ }
+ if (!memcmp(name, "seekdir", 7)) {
+ /* ^ */
+ return -KEY_seekdir; /* Weight 20 */
+ }
+ 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;
- break;
- case 3:
- 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,"lock")) return -KEY_lock;
- break;
- case 5:
- if (strEQ(d,"local")) return KEY_local;
- if (strEQ(d,"lstat")) return -KEY_lstat;
- break;
- case 6:
- if (strEQ(d,"length")) return -KEY_length;
- if (strEQ(d,"listen")) return -KEY_listen;
- break;
- case 7:
- if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
- break;
- case 9:
- if (strEQ(d,"localtime")) return -KEY_localtime;
- break;
- }
- break;
+ if (!memcmp(name, "symlink", 7)) {
+ /* ^ */
+ return -KEY_symlink; /* Weight 386 */
+ }
+ if (!memcmp(name, "telldir", 7)) {
+ /* ^ */
+ return -KEY_telldir; /* Weight 294 */
+ }
+ break;
case 'm':
- switch (len) {
- case 1: return KEY_m;
- 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;
- 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;
- break;
- }
- break;
+ if (!memcmp(name, "binmode", 7)) {
+ /* ^ */
+ return -KEY_binmode; /* Weight 12301 */
+ }
+ break;
case 'n':
- if (strEQ(d,"next")) return KEY_next;
- if (strEQ(d,"ne")) return -KEY_ne;
- if (strEQ(d,"not")) return -KEY_not;
- if (strEQ(d,"no")) return KEY_no;
- break;
+ if (!memcmp(name, "opendir", 7)) {
+ /* ^ */
+ return -KEY_opendir; /* Weight 9007 */
+ }
+ if (!memcmp(name, "connect", 7)) {
+ /* ^ */
+ return -KEY_connect; /* Weight 526 */
+ }
+ break;
case 'o':
- switch (len) {
- case 2:
- 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,"our")) return KEY_our;
- break;
- case 4:
- if (strEQ(d,"open")) return -KEY_open;
- break;
- case 7:
- if (strEQ(d,"opendir")) return -KEY_opendir;
- break;
- }
- break;
+ if (!memcmp(name, "sysopen", 7)) {
+ /* ^ */
+ return -KEY_sysopen; /* Weight 1230 */
+ }
+ if (!memcmp(name, "dbmopen", 7)) {
+ /* ^ */
+ return -KEY_dbmopen;
+ }
+ break;
case 'p':
- 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;
- break;
- case 5:
- if (strEQ(d,"print")) return KEY_print;
- break;
- case 6:
- if (strEQ(d,"printf")) return KEY_printf;
- break;
- case 7:
- if (strEQ(d,"package")) return KEY_package;
- break;
- case 9:
- if (strEQ(d,"prototype")) return KEY_prototype;
- }
- 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;
- }
- else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
- break;
+ if (!memcmp(name, "getppid", 7)) {
+ /* ^ */
+ return -KEY_getppid; /* Weight 10 */
+ }
+ if (!memcmp(name, "getpgrp", 7)) {
+ /* ^ */
+ return -KEY_getpgrp;
+ }
+ if (!memcmp(name, "setpgrp", 7)) {
+ /* ^ */
+ return -KEY_setpgrp;
+ }
+ break;
case 'r':
- switch (len) {
- case 3:
- 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,"redo")) return KEY_redo;
- break;
- case 5:
- 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;
- break;
- case 7:
- 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;
- break;
- case 9:
- if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
- break;
- }
- break;
+ if (!memcmp(name, "sysread", 7)) {
+ /* ^ */
+ return -KEY_sysread; /* Weight 3729 */
+ }
+ if (!memcmp(name, "shmread", 7)) {
+ /* ^ */
+ return -KEY_shmread;
+ }
+ break;
case 's':
- switch (d[1]) {
- case 0: return KEY_s;
- case 'c':
- if (strEQ(d,"scalar")) return KEY_scalar;
- break;
- case 'e':
- switch (len) {
- case 4:
- if (strEQ(d,"seek")) return -KEY_seek;
- if (strEQ(d,"send")) return -KEY_send;
- break;
- case 5:
- 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;
- break;
- case 7:
- 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;
- break;
- case 9:
- 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;
- break;
- case 11:
- if (strEQ(d,"setpriority")) return -KEY_setpriority;
- if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
- break;
- }
- break;
- case 'h':
- switch (len) {
- case 5:
- if (strEQ(d,"shift")) return -KEY_shift;
- break;
- case 6:
- if (strEQ(d,"shmctl")) return -KEY_shmctl;
- if (strEQ(d,"shmget")) return -KEY_shmget;
- break;
- case 7:
- if (strEQ(d,"shmread")) return -KEY_shmread;
- break;
- case 8:
- 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;
- break;
- case 'l':
- 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;
- break;
- case 'p':
- if (strEQ(d,"split")) return KEY_split;
- if (strEQ(d,"sprintf")) return -KEY_sprintf;
- if (strEQ(d,"splice")) return -KEY_splice;
- break;
- case 'q':
- if (strEQ(d,"sqrt")) return -KEY_sqrt;
- break;
- case 'r':
- if (strEQ(d,"srand")) return -KEY_srand;
- break;
- case 't':
- 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,"sub")) return KEY_sub;
- break;
- case 'y':
- switch (len) {
- case 6:
- if (strEQ(d,"system")) return -KEY_system;
- break;
- case 7:
- 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,"sysseek")) return -KEY_sysseek;
- break;
- case 8:
- if (strEQ(d,"syswrite")) return -KEY_syswrite;
- break;
- }
- break;
- }
- break;
+ if (!memcmp(name, "sysseek", 7)) {
+ /* ^ */
+ return -KEY_sysseek; /* Weight 721 */
+ }
+ break;
case 't':
- switch (len) {
- case 2:
- if (strEQ(d,"tr")) return KEY_tr;
- break;
- case 3:
- if (strEQ(d,"tie")) return KEY_tie;
- break;
- case 4:
- 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;
- break;
- case 7:
- if (strEQ(d,"telldir")) return -KEY_telldir;
- break;
- case 8:
- if (strEQ(d,"truncate")) return -KEY_truncate;
- break;
- }
- break;
+ if (!memcmp(name, "waitpid", 7)) {
+ /* ^ */
+ return -KEY_waitpid; /* Weight 414 */
+ }
+ break;
case 'u':
- switch (len) {
- case 2:
- 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;
- break;
- case 6:
- if (strEQ(d,"unless")) return KEY_unless;
- 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;
- break;
- }
- break;
- case 'v':
- if (strEQ(d,"values")) return -KEY_values;
- if (strEQ(d,"vec")) return -KEY_vec;
- break;
+ if (!memcmp(name, "require", 7)) {
+ /* ^ */
+ return KEY_require; /* Weight 375220 */
+ }
+ break;
+ }
+ break;
+ case 8:
+ /* Names all of length 8. */
+ /* AUTOLOAD __DATA__ __FILE__ __LINE__ closedir continue dbmclose endgrent
+ endpwent formline getgrent getgrgid getgrnam getlogin getpwent getpwnam
+ getpwuid readline readlink readpipe setgrent setpwent shmwrite shutdown
+ syswrite truncate */
+ /* Offset 3 gives the best switch position. */
+ switch (name[3]) {
+ case 'A':
+ if (!memcmp(name, "__DATA__", 8)) {
+ /* ^ */
+ return KEY___DATA__; /* Weight 395 */
+ }
+ break;
+ case 'I':
+ if (!memcmp(name, "__FILE__", 8)) {
+ /* ^ */
+ return -KEY___FILE__; /* Weight 888 */
+ }
+ if (!memcmp(name, "__LINE__", 8)) {
+ /* ^ */
+ return -KEY___LINE__; /* Weight 209 */
+ }
+ break;
+ case 'O':
+ if (!memcmp(name, "AUTOLOAD", 8)) {
+ /* ^ */
+ return KEY_AUTOLOAD; /* Weight 2713 */
+ }
+ break;
+ case 'c':
+ if (!memcmp(name, "dbmclose", 8)) {
+ /* ^ */
+ return -KEY_dbmclose;
+ }
+ break;
+ case 'd':
+ if (!memcmp(name, "readlink", 8)) {
+ /* ^ */
+ return -KEY_readlink; /* Weight 1537 */
+ }
+ if (!memcmp(name, "readline", 8)) {
+ /* ^ */
+ return -KEY_readline; /* Weight 19 */
+ }
+ if (!memcmp(name, "readpipe", 8)) {
+ /* ^ */
+ return -KEY_readpipe;
+ }
+ break;
+ case 'g':
+ if (!memcmp(name, "getgrgid", 8)) {
+ /* ^ */
+ return -KEY_getgrgid; /* Weight 67 */
+ }
+ if (!memcmp(name, "getgrnam", 8)) {
+ /* ^ */
+ return -KEY_getgrnam; /* Weight 11 */
+ }
+ if (!memcmp(name, "endgrent", 8)) {
+ /* ^ */
+ return -KEY_endgrent;
+ }
+ if (!memcmp(name, "getgrent", 8)) {
+ /* ^ */
+ return -KEY_getgrent;
+ }
+ if (!memcmp(name, "setgrent", 8)) {
+ /* ^ */
+ return -KEY_setgrent;
+ }
+ break;
+ case 'l':
+ if (!memcmp(name, "getlogin", 8)) {
+ /* ^ */
+ return -KEY_getlogin; /* Weight 158 */
+ }
+ break;
+ case 'm':
+ if (!memcmp(name, "formline", 8)) {
+ /* ^ */
+ return -KEY_formline; /* Weight 959 */
+ }
+ break;
+ case 'n':
+ if (!memcmp(name, "truncate", 8)) {
+ /* ^ */
+ return -KEY_truncate; /* Weight 1351 */
+ }
+ break;
+ case 'p':
+ if (!memcmp(name, "getpwuid", 8)) {
+ /* ^ */
+ return -KEY_getpwuid; /* Weight 681 */
+ }
+ if (!memcmp(name, "getpwnam", 8)) {
+ /* ^ */
+ return -KEY_getpwnam; /* Weight 483 */
+ }
+ if (!memcmp(name, "getpwent", 8)) {
+ /* ^ */
+ return -KEY_getpwent; /* Weight 12 */
+ }
+ if (!memcmp(name, "endpwent", 8)) {
+ /* ^ */
+ return -KEY_endpwent;
+ }
+ if (!memcmp(name, "setpwent", 8)) {
+ /* ^ */
+ return -KEY_setpwent;
+ }
+ break;
+ case 's':
+ if (!memcmp(name, "closedir", 8)) {
+ /* ^ */
+ return -KEY_closedir; /* Weight 11986 */
+ }
+ break;
+ case 't':
+ if (!memcmp(name, "continue", 8)) {
+ /* ^ */
+ return -KEY_continue; /* Weight 2925 */
+ }
+ if (!memcmp(name, "shutdown", 8)) {
+ /* ^ */
+ return -KEY_shutdown;
+ }
+ break;
case 'w':
- switch (len) {
- case 4:
- 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;
- break;
- case 7:
- if (strEQ(d,"waitpid")) return -KEY_waitpid;
- break;
- case 9:
- if (strEQ(d,"wantarray")) return -KEY_wantarray;
- break;
- }
- break;
- case 'x':
- if (len == 1) return -KEY_x;
- if (strEQ(d,"xor")) return -KEY_xor;
- break;
- case 'y':
- if (len == 1) return KEY_y;
- break;
- case 'z':
- break;
+ if (!memcmp(name, "syswrite", 8)) {
+ /* ^ */
+ return -KEY_syswrite; /* Weight 4437 */
+ }
+ if (!memcmp(name, "shmwrite", 8)) {
+ /* ^ */
+ return -KEY_shmwrite;
+ }
+ break;
}
- return 0;
+ break;
+ case 9:
+ /* Names all of length 9. */
+ /* endnetent getnetent localtime prototype quotemeta rewinddir setnetent
+ wantarray */
+ /* Offset 0 gives the best switch position. */
+ switch (*name++) {
+ case 'e':
+ if (!memcmp(name, "ndnetent", 8)) {
+ /* e */
+ return -KEY_endnetent;
+ }
+ break;
+ case 'g':
+ if (!memcmp(name, "etnetent", 8)) {
+ /* g */
+ return -KEY_getnetent;
+ }
+ break;
+ case 'l':
+ if (!memcmp(name, "ocaltime", 8)) {
+ /* l */
+ return -KEY_localtime; /* Weight 7993 */
+ }
+ break;
+ case 'p':
+ if (!memcmp(name, "rototype", 8)) {
+ /* p */
+ return KEY_prototype; /* Weight 1602 */
+ }
+ break;
+ case 'q':
+ if (!memcmp(name, "uotemeta", 8)) {
+ /* q */
+ return -KEY_quotemeta; /* Weight 3120 */
+ }
+ break;
+ case 'r':
+ if (!memcmp(name, "ewinddir", 8)) {
+ /* r */
+ return -KEY_rewinddir; /* Weight 218 */
+ }
+ break;
+ case 's':
+ if (!memcmp(name, "etnetent", 8)) {
+ /* s */
+ return -KEY_setnetent; /* Weight 1 */
+ }
+ break;
+ case 'w':
+ if (!memcmp(name, "antarray", 8)) {
+ /* w */
+ return -KEY_wantarray; /* Weight 43024 */
+ }
+ break;
+ }
+ break;
+ case 10:
+ /* Names all of length 10. */
+ /* endhostent endservent gethostent getservent getsockopt sethostent
+ setservent setsockopt socketpair */
+ /* Offset 6 gives the best switch position. */
+ switch (name[6]) {
+ case 'k':
+ if (!memcmp(name, "setsockopt", 10)) {
+ /* ^ */
+ return -KEY_setsockopt; /* Weight 356 */
+ }
+ if (!memcmp(name, "getsockopt", 10)) {
+ /* ^ */
+ return -KEY_getsockopt; /* Weight 243 */
+ }
+ break;
+ case 'p':
+ if (!memcmp(name, "socketpair", 10)) {
+ /* ^ */
+ return -KEY_socketpair;
+ }
+ break;
+ case 't':
+ if (!memcmp(name, "gethostent", 10)) {
+ /* ^ */
+ return -KEY_gethostent; /* Weight 3 */
+ }
+ if (!memcmp(name, "endhostent", 10)) {
+ /* ^ */
+ return -KEY_endhostent;
+ }
+ if (!memcmp(name, "sethostent", 10)) {
+ /* ^ */
+ return -KEY_sethostent;
+ }
+ break;
+ case 'v':
+ if (!memcmp(name, "getservent", 10)) {
+ /* ^ */
+ return -KEY_getservent; /* Weight 4 */
+ }
+ if (!memcmp(name, "endservent", 10)) {
+ /* ^ */
+ return -KEY_endservent;
+ }
+ if (!memcmp(name, "setservent", 10)) {
+ /* ^ */
+ return -KEY_setservent;
+ }
+ break;
+ }
+ break;
+ case 11:
+ /* Names all of length 11. */
+ /* __PACKAGE__ endprotoent getpeername getpriority getprotoent getsockname
+ setpriority setprotoent */
+ /* Offset 5 gives the best switch position. */
+ switch (name[5]) {
+ case 'K':
+ if (!memcmp(name, "__PACKAGE__", 11)) {
+ /* ^ */
+ return -KEY___PACKAGE__; /* Weight 36767 */
+ }
+ break;
+ case 'c':
+ if (!memcmp(name, "getsockname", 11)) {
+ /* ^ */
+ return -KEY_getsockname; /* Weight 235 */
+ }
+ break;
+ case 'e':
+ if (!memcmp(name, "getpeername", 11)) {
+ /* ^ */
+ return -KEY_getpeername; /* Weight 713 */
+ }
+ break;
+ case 'i':
+ if (!memcmp(name, "getpriority", 11)) {
+ /* ^ */
+ return -KEY_getpriority; /* Weight 5 */
+ }
+ if (!memcmp(name, "setpriority", 11)) {
+ /* ^ */
+ return -KEY_setpriority; /* Weight 2 */
+ }
+ break;
+ case 'o':
+ if (!memcmp(name, "endprotoent", 11)) {
+ /* ^ */
+ return -KEY_endprotoent;
+ }
+ if (!memcmp(name, "getprotoent", 11)) {
+ /* ^ */
+ return -KEY_getprotoent;
+ }
+ if (!memcmp(name, "setprotoent", 11)) {
+ /* ^ */
+ return -KEY_setprotoent;
+ }
+ break;
+ }
+ break;
+ case 12:
+ /* Names all of length 12. */
+ /* getnetbyaddr getnetbyname */
+ /* Offset 9 gives the best switch position. */
+ switch (name[9]) {
+ case 'a':
+ if (!memcmp(name, "getnetbyname", 12)) {
+ /* ^ */
+ return -KEY_getnetbyname;
+ }
+ break;
+ case 'd':
+ if (!memcmp(name, "getnetbyaddr", 12)) {
+ /* ^ */
+ return -KEY_getnetbyaddr;
+ }
+ break;
+ }
+ break;
+ case 13:
+ /* Names all of length 13. */
+ /* gethostbyaddr gethostbyname getservbyname getservbyport */
+ /* Offset 10 gives the best switch position. */
+ switch (name[10]) {
+ case 'a':
+ if (!memcmp(name, "gethostbyname", 13)) {
+ /* ^ */
+ return -KEY_gethostbyname; /* Weight 970 */
+ }
+ if (!memcmp(name, "getservbyname", 13)) {
+ /* ^ */
+ return -KEY_getservbyname; /* Weight 299 */
+ }
+ break;
+ case 'd':
+ if (!memcmp(name, "gethostbyaddr", 13)) {
+ /* ^ */
+ return -KEY_gethostbyaddr; /* Weight 68 */
+ }
+ break;
+ case 'o':
+ if (!memcmp(name, "getservbyport", 13)) {
+ /* ^ */
+ return -KEY_getservbyport;
+ }
+ break;
+ }
+ break;
+ case 14:
+ if (!memcmp(name, "getprotobyname", 14)) {
+ return -KEY_getprotobyname; /* Weight 755 */
+ }
+ break;
+ case 16:
+ if (!memcmp(name, "getprotobynumber", 16)) {
+ return -KEY_getprotobynumber; /* Weight 232 */
+ }
+ break;
+ }
+ return 0;
}
STATIC void
return res;
}
+/* Returns a NUL terminated string, with the length of the string written to
+ *slp
+ */
STATIC char *
S_scan_word(pTHX_ register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
{
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);
sv_setpvn(tmpstr,d+1,s-d);
s += len - 1;
sv_catpvn(herewas,s,bufend-s);
- (void)strcpy(bufptr,SvPVX(herewas));
+ Copy(SvPVX(herewas),bufptr,SvCUR(herewas) + 1,char);
s = olds;
goto retval;
av_store(CopFILEAV(PL_curcop), (I32)CopLINE(PL_curcop),sv);
}
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
- s = PL_bufend - 1;
- *s = ' ';
+ STRLEN off = PL_bufend - 1 - SvPVX(PL_linestr);
+ *(SvPVX(PL_linestr) + off ) = ' ';
sv_catsv(PL_linestr,herewas);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ s = SvPVX(PL_linestr) + off; /* In case PV of PL_linestr moved. */
}
else {
s = PL_bufend;
/* turn <> into <ARGV> */
if (!len)
- (void)strcpy(d,"ARGV");
+ Copy("ARGV",d,5,char);
/* Check whether readline() is overriden */
if (((gv_readline = gv_fetchpv("readline", FALSE, SVt_PVCV))
I32 brackets = 1; /* bracket nesting level */
bool has_utf8 = FALSE; /* is there any utf8 content? */
I32 termcode; /* terminating char. code */
- U8 termstr[UTF8_MAXLEN]; /* terminating string */
+ U8 termstr[UTF8_MAXBYTES]; /* terminating string */
STRLEN termlen; /* length of terminating string */
char *last = NULL; /* last position for nesting bracket */
}
/* 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++;
{
STRLEN slen;
slen = SvCUR(PL_linestr);
- switch (*s) {
+ switch (s[0]) {
case 0xFF:
if (s[1] == 0xFE) {
- /* UTF-16 little-endian */
+ /* UTF-16 little-endian? (or UTF32-LE?) */
if (s[2] == 0 && s[3] == 0) /* UTF-32 little-endian */
- Perl_croak(aTHX_ "Unsupported script encoding");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF32-LE");
#ifndef PERL_NO_UTF16_FILTER
- DEBUG_p(PerlIO_printf(Perl_debug_log, "UTF-LE script encoding\n"));
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF16-LE script encoding (BOM)\n");
s += 2;
+ utf16le:
if (PL_bufend > (char*)s) {
U8 *news;
I32 newlen;
filter_add(utf16rev_textfilter, NULL);
New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
- PL_bufend = (char*)utf16_to_utf8_reversed(s, news,
- PL_bufend - (char*)s - 1,
- &newlen);
- Copy(news, s, newlen, U8);
- SvCUR_set(PL_linestr, newlen);
- PL_bufend = SvPVX(PL_linestr) + newlen;
- news[newlen++] = '\0';
+ utf16_to_utf8_reversed(s, news,
+ PL_bufend - (char*)s - 1,
+ &newlen);
+ sv_setpvn(PL_linestr, (const char*)news, newlen);
Safefree(news);
+ SvUTF8_on(PL_linestr);
+ s = (U8*)SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + newlen;
}
#else
- Perl_croak(aTHX_ "Unsupported script encoding");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF16-LE");
#endif
}
break;
case 0xFE:
- if (s[1] == 0xFF) { /* UTF-16 big-endian */
+ if (s[1] == 0xFF) { /* UTF-16 big-endian? */
#ifndef PERL_NO_UTF16_FILTER
- DEBUG_p(PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding\n"));
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (BOM)\n");
s += 2;
+ utf16be:
if (PL_bufend > (char *)s) {
U8 *news;
I32 newlen;
filter_add(utf16_textfilter, NULL);
New(898, news, (PL_bufend - (char*)s) * 3 / 2 + 1, U8);
- PL_bufend = (char*)utf16_to_utf8(s, news,
- PL_bufend - (char*)s,
- &newlen);
- Copy(news, s, newlen, U8);
- SvCUR_set(PL_linestr, newlen);
- PL_bufend = SvPVX(PL_linestr) + newlen;
- news[newlen++] = '\0';
+ utf16_to_utf8(s, news,
+ PL_bufend - (char*)s,
+ &newlen);
+ sv_setpvn(PL_linestr, (const char*)news, newlen);
Safefree(news);
+ SvUTF8_on(PL_linestr);
+ s = (U8*)SvPVX(PL_linestr);
+ PL_bufend = SvPVX(PL_linestr) + newlen;
}
#else
- Perl_croak(aTHX_ "Unsupported script encoding");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF16-BE");
#endif
}
break;
case 0xEF:
if (slen > 2 && s[1] == 0xBB && s[2] == 0xBF) {
- DEBUG_p(PerlIO_printf(Perl_debug_log, "UTF-8 script encoding\n"));
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-8 script encoding (BOM)\n");
s += 3; /* UTF-8 */
}
break;
case 0:
- if (slen > 3 && s[1] == 0 && /* UTF-32 big-endian */
- s[2] == 0xFE && s[3] == 0xFF)
- {
- Perl_croak(aTHX_ "Unsupported script encoding");
+ if (slen > 3) {
+ if (s[1] == 0) {
+ if (s[2] == 0xFE && s[3] == 0xFF) {
+ /* UTF-32 big-endian */
+ Perl_croak(aTHX_ "Unsupported script encoding UTF32-BE");
+ }
+ }
+ else if (s[2] == 0 && s[3] != 0) {
+ /* Leading bytes
+ * 00 xx 00 xx
+ * are a good indicator of UTF-16BE. */
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
+ goto utf16be;
+ }
}
+ default:
+ if (slen > 3 && s[1] == 0 && s[2] != 0 && s[3] == 0) {
+ /* Leading bytes
+ * xx 00 xx 00
+ * are a good indicator of UTF-16LE. */
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
+ goto utf16le;
+ }
}
return (char*)s;
}
static I32
utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
+ STRLEN old = SvCUR(sv);
I32 count = FILTER_READ(idx+1, sv, maxlen);
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "utf16_textfilter(%p): %d %d (%d)\n",
+ utf16_textfilter, idx, maxlen, (int) count));
if (count) {
U8* tmps;
- U8* tend;
I32 newlen;
New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
- if (!*SvPV_nolen(sv))
- /* Game over, but don't feed an odd-length string to utf16_to_utf8 */
- return count;
-
- tend = utf16_to_utf8((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen);
- sv_usepvn(sv, (char*)tmps, tend - tmps);
+ Copy(SvPVX(sv), tmps, old, char);
+ utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old,
+ SvCUR(sv) - old, &newlen);
+ sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old);
}
- return count;
+ DEBUG_P({sv_dump(sv);});
+ return SvCUR(sv);
}
static I32
utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen)
{
+ STRLEN old = SvCUR(sv);
I32 count = FILTER_READ(idx+1, sv, maxlen);
+ DEBUG_P(PerlIO_printf(Perl_debug_log,
+ "utf16rev_textfilter(%p): %d %d (%d)\n",
+ utf16rev_textfilter, idx, maxlen, (int) count));
if (count) {
U8* tmps;
- U8* tend;
I32 newlen;
- if (!*SvPV_nolen(sv))
- /* Game over, but don't feed an odd-length string to utf16_to_utf8 */
- return count;
-
New(898, tmps, SvCUR(sv) * 3 / 2 + 1, U8);
- tend = utf16_to_utf8_reversed((U8*)SvPVX(sv), tmps, SvCUR(sv), &newlen);
- sv_usepvn(sv, (char*)tmps, tend - tmps);
+ Copy(SvPVX(sv), tmps, old, char);
+ utf16_to_utf8((U8*)SvPVX(sv) + old, tmps + old,
+ SvCUR(sv) - old, &newlen);
+ sv_usepvn(sv, (char*)tmps, (STRLEN)newlen + old);
}
+ DEBUG_P({ sv_dump(sv); });
return count;
}
#endif
if (!isALPHA(*pos)) {
UV rev;
- U8 tmpbuf[UTF8_MAXLEN+1];
+ U8 tmpbuf[UTF8_MAXBYTES+1];
U8 *tmpend;
if (*s == 'v') s++; /* get past 'v' */
https://perl5.git.perl.org / perl5.git / blobdiff