SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
SAVESPTR(PL_linestr);
- SAVEPPTR(PL_lex_brackstack);
- SAVEPPTR(PL_lex_casestack);
+ SAVEGENERICPV(PL_lex_brackstack);
+ SAVEGENERICPV(PL_lex_casestack);
SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
SAVESPTR(PL_lex_stuff);
SAVEI32(PL_lex_defer);
PL_lex_brackets = 0;
New(899, PL_lex_brackstack, 120, char);
New(899, PL_lex_casestack, 12, char);
- SAVEFREEPV(PL_lex_brackstack);
- SAVEFREEPV(PL_lex_casestack);
PL_lex_casemods = 0;
*PL_lex_casestack = '\0';
PL_lex_dojoin = 0;
SAVEPPTR(PL_last_uni);
SAVEPPTR(PL_linestart);
SAVESPTR(PL_linestr);
- SAVEPPTR(PL_lex_brackstack);
- SAVEPPTR(PL_lex_casestack);
+ SAVEGENERICPV(PL_lex_brackstack);
+ SAVEGENERICPV(PL_lex_casestack);
PL_linestr = PL_lex_stuff;
PL_lex_stuff = Nullsv;
PL_lex_brackets = 0;
New(899, PL_lex_brackstack, 120, char);
New(899, PL_lex_casestack, 12, char);
- SAVEFREEPV(PL_lex_brackstack);
- SAVEFREEPV(PL_lex_casestack);
PL_lex_casemods = 0;
*PL_lex_casestack = '\0';
PL_lex_starts = 0;
/* \c is a control character */
case 'c':
s++;
- {
+ if (s < send) {
U8 c = *s++;
#ifdef EBCDIC
if (isLOWER(c))
#endif
*d++ = NATIVE_TO_NEED(has_utf8,toCTRL(c));
}
+ else {
+ yyerror("Missing control char name in \\c");
+ }
continue;
/* printf-style backslashes, formfeeds, newlines, etc */
GV *gv = Nullgv;
GV **gvp = 0;
bool bof = FALSE;
+ I32 orig_keyword = 0;
/* check if there's an identifier for us to look at */
if (PL_pending_ident)
DEBUG_T({ PerlIO_printf(Perl_debug_log,
"### Saw case modifier at '%s'\n", PL_bufptr); });
s = PL_bufptr + 1;
- 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) &&
- (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U')))
- {
- PL_lex_casestack[--PL_lex_casemods] = '\0';
- return ')';
+ if (s[1] == '\\' && s[2] == 'E') {
+ PL_bufptr = s + 3;
+ PL_lex_state = LEX_INTERPCONCAT;
+ return yylex();
}
- if (PL_lex_casemods > 10) {
- char* newlb = Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
- if (newlb != PL_lex_casestack) {
- SAVEFREEPV(newlb);
- PL_lex_casestack = newlb;
+ 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) &&
+ (strchr(PL_lex_casestack, 'L') || strchr(PL_lex_casestack, 'U'))) {
+ PL_lex_casestack[--PL_lex_casemods] = '\0';
+ return ')';
}
+ if (PL_lex_casemods > 10)
+ Renew(PL_lex_casestack, PL_lex_casemods + 2, char);
+ PL_lex_casestack[PL_lex_casemods++] = *s;
+ PL_lex_casestack[PL_lex_casemods] = '\0';
+ PL_lex_state = LEX_INTERPCONCAT;
+ PL_nextval[PL_nexttoke].ival = 0;
+ force_next('(');
+ if (*s == 'l')
+ PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
+ else if (*s == 'u')
+ PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
+ else if (*s == 'L')
+ PL_nextval[PL_nexttoke].ival = OP_LC;
+ else if (*s == 'U')
+ PL_nextval[PL_nexttoke].ival = OP_UC;
+ else if (*s == 'Q')
+ PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
+ else
+ Perl_croak(aTHX_ "panic: yylex");
+ PL_bufptr = s + 1;
}
- PL_lex_casestack[PL_lex_casemods++] = *s;
- PL_lex_casestack[PL_lex_casemods] = '\0';
- PL_lex_state = LEX_INTERPCONCAT;
- PL_nextval[PL_nexttoke].ival = 0;
- force_next('(');
- if (*s == 'l')
- PL_nextval[PL_nexttoke].ival = OP_LCFIRST;
- else if (*s == 'u')
- PL_nextval[PL_nexttoke].ival = OP_UCFIRST;
- else if (*s == 'L')
- PL_nextval[PL_nexttoke].ival = OP_LC;
- else if (*s == 'U')
- PL_nextval[PL_nexttoke].ival = OP_UC;
- else if (*s == 'Q')
- PL_nextval[PL_nexttoke].ival = OP_QUOTEMETA;
- else
- Perl_croak(aTHX_ "panic: yylex");
- PL_bufptr = s + 1;
force_next(FUNC);
if (PL_lex_starts) {
s = PL_bufptr;
leftbracket:
s++;
if (PL_lex_brackets > 100) {
- char* newlb = Renew(PL_lex_brackstack, PL_lex_brackets + 1, char);
- if (newlb != PL_lex_brackstack) {
- SAVEFREEPV(newlb);
- PL_lex_brackstack = newlb;
- }
+ Renew(PL_lex_brackstack, PL_lex_brackets + 10, char);
}
switch (PL_expect) {
case XTERM:
case 'z': case 'Z':
keylookup: {
- I32 orig_keyword = 0;
+ orig_keyword = 0;
gv = Nullgv;
gvp = 0;
d[tmp] = '\0';
if (bad_proto && ckWARN(WARN_SYNTAX))
Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
- "Illegal character in prototype for %s : %s",
- SvPVX(PL_subname), d);
+ "Illegal character in prototype for %"SVf" : %s",
+ PL_subname, d);
SvCUR(PL_lex_stuff) = tmp;
have_proto = TRUE;
if (*s == ':' && s[1] != ':')
PL_expect = attrful;
+ else if (!have_name && *s != '{' && key == KEY_sub)
+ Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
if (have_proto) {
PL_nextval[PL_nexttoke].opval =
*/
if (!strchr(PL_tokenbuf,':')) {
- if ((tmp = pad_findmy(PL_tokenbuf)) != NOT_IN_PAD) {
+ if (!PL_in_my)
+ tmp = pad_findmy(PL_tokenbuf);
+ if (tmp != NOT_IN_PAD) {
/* might be an "our" variable" */
if (PAD_COMPNAME_FLAGS(tmp) & SVpad_OUR) {
/* build ops for a bareword */
PL_subline = CopLINE(PL_curcop);
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc(outsidecv);
+ CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
return oldsavestack_ix;
}