((0 != (PL_hints & HINT_LOCALIZE_HH)) \
&& S_feature_is_enabled(aTHX_ STR_WITH_LEN(name)))
/* The longest string we pass in. */
-#define MAX_FEATURE_LEN (sizeof("switch")-1)
+#define MAX_FEATURE_LEN (sizeof("unicode_strings")-1)
/*
* S_feature_is_enabled
STRLEN old_bufend_pos, new_bufend_pos;
STRLEN bufptr_pos, oldbufptr_pos, oldoldbufptr_pos;
STRLEN linestart_pos, last_uni_pos, last_lop_pos;
+ bool got_some_for_debugger = 0;
bool got_some;
if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
-#ifdef PERL_MAD
- flags |= LEX_KEEP_PREVIOUS;
-#endif /* PERL_MAD */
linestr = PL_parser->linestr;
buf = SvPVX(linestr);
if (!(flags & LEX_KEEP_PREVIOUS) &&
got_some = 0;
} else if (filter_gets(linestr, old_bufend_pos)) {
got_some = 1;
+ got_some_for_debugger = 1;
} else {
if (!SvPOK(linestr)) /* can get undefined by filter_gets */
sv_setpvs(linestr, "");
PL_parser->last_uni = buf + last_uni_pos;
if (PL_parser->last_lop)
PL_parser->last_lop = buf + last_lop_pos;
- if (got_some && (PERLDB_LINE || PERLDB_SAVESRC) &&
+ if (got_some_for_debugger && (PERLDB_LINE || PERLDB_SAVESRC) &&
PL_curstash != PL_debstash) {
/* debugger active and we're not compiling the debugger code,
* so store the line into the debugger's array of lines
=cut
*/
+#define LEX_NO_NEXT_CHUNK 0x80000000
+
void
Perl_lex_read_space(pTHX_ U32 flags)
{
char *s, *bufend;
bool need_incline = 0;
- if (flags & ~(LEX_KEEP_PREVIOUS))
+ if (flags & ~(LEX_KEEP_PREVIOUS|LEX_NO_NEXT_CHUNK))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_read_space");
#ifdef PERL_MAD
if (PL_skipwhite) {
if (PL_madskills)
sv_catpvn(PL_skipwhite, PL_parser->bufptr, s-PL_parser->bufptr);
#endif /* PERL_MAD */
+ if (flags & LEX_NO_NEXT_CHUNK)
+ break;
PL_parser->bufptr = s;
CopLINE_inc(PL_curcop);
got_more = lex_next_chunk(flags);
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
while (s < PL_bufend && SPACE_OR_TAB(*s))
s++;
- } else if (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE) {
- while (isSPACE(*s) && *s != '\n')
- s++;
- if (*s == '#') {
- do {
- s++;
- } while (s != PL_bufend && *s != '\n');
- }
- if (*s == '\n')
- s++;
} else {
STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
PL_bufptr = s;
- lex_read_space(LEX_KEEP_PREVIOUS);
+ lex_read_space(LEX_KEEP_PREVIOUS |
+ (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
+ LEX_NO_NEXT_CHUNK : 0));
s = PL_bufptr;
PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
if (PL_linestart > PL_bufptr)
s = SKIPSPACE1(s);
if (isDIGIT(*s) || (*s == 'v' && isDIGIT(s[1]))) {
s = force_version(s, TRUE);
- if (*s == ';' || (s = SKIPSPACE1(s), *s == ';')) {
+ if (*s == ';' || *s == '}'
+ || (s = SKIPSPACE1(s), (*s == ';' || *s == '}'))) {
start_force(PL_curforce);
NEXTVAL_NEXTTOKE.opval = NULL;
force_next(WORD);
fake_eof = LEX_FAKE_EOF;
}
PL_bufptr = PL_bufend;
+ CopLINE_inc(PL_curcop);
if (!lex_next_chunk(fake_eof)) {
+ CopLINE_dec(PL_curcop);
s = PL_bufptr;
TOKEN(';'); /* not infinite loop because rsfp is NULL now */
}
+ CopLINE_dec(PL_curcop);
#ifdef PERL_MAD
if (!PL_rsfp)
PL_realtokenstart = -1;
PL_doextract = FALSE;
}
}
- incline(s);
+ if (PL_rsfp)
+ incline(s);
} while (PL_doextract);
PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
- if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
- update_debugger_info(PL_linestr, NULL, 0);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
if (CopLINE(PL_curcop) == 1) {
d = s;
{
const char tmp = *s;
- if (PL_lex_state == LEX_NORMAL)
+ if (PL_lex_state == LEX_NORMAL || PL_lex_brackets)
s = SKIPSPACE1(s);
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop)
pl_yylval.ival = 0;
OPERATOR(DOTDOT);
}
- if (PL_expect != XOPERATOR)
- check_uni();
Aop(OP_CONCAT);
}
/* FALL THROUGH */
case KEY_eval:
s = SKIPSPACE1(s);
- PL_expect = (*s == '{') ? XTERMBLOCK : XTERM;
- UNIBRACK(OP_ENTEREVAL);
+ if (*s == '{') { /* block eval */
+ PL_expect = XTERMBLOCK;
+ UNIBRACK(OP_ENTERTRY);
+ }
+ else { /* string eval */
+ PL_expect = XTERM;
+ UNIBRACK(OP_ENTEREVAL);
+ }
case KEY_eof:
UNI(OP_EOF);
else if (*s != '{' && key == KEY_sub) {
if (!have_name)
Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine");
- else if (*s != ';')
+ else if (*s != ';' && *s != '}')
Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, SVfARG(PL_subname));
}
char *bracket = NULL;
char funny = *s++;
register char *d = dest;
- register char * const e = d + destlen + 3; /* two-character token, ending NUL */
+ register char * const e = d + destlen - 3; /* two-character token, ending NUL */
PERL_ARGS_ASSERT_SCAN_IDENT;
}
#endif
PL_bufptr = s;
+ CopLINE_inc(PL_curcop);
if (!outer || !lex_next_chunk(0)) {
CopLINE_set(PL_curcop, (line_t)PL_multi_start);
missingterm(PL_tokenbuf);
}
+ CopLINE_dec(PL_curcop);
s = PL_bufptr;
#ifdef PERL_MAD
stuffstart = s - SvPVX(PL_linestr);
else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
PL_bufend[-1] = '\n';
#endif
- if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
- update_debugger_info(PL_linestr, NULL, 0);
if (*s == term && memEQ(s,PL_tokenbuf,len)) {
STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
*(SvPVX(PL_linestr) + off ) = ' ';
switch (s[0]) {
case 0xFF:
if (s[1] == 0xFE) {
- /* UTF-16 little-endian? (or UTF32-LE?) */
+ /* UTF-16 little-endian? (or UTF-32LE?) */
if (s[2] == 0 && s[3] == 0) /* UTF-32 little-endian */
- Perl_croak(aTHX_ "Unsupported script encoding UTF32-LE");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
#ifndef PERL_NO_UTF16_FILTER
- if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF16-LE script encoding (BOM)\n");
+ if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
s += 2;
if (PL_bufend > (char*)s) {
s = add_utf16_textfilter(s, TRUE);
}
#else
- Perl_croak(aTHX_ "Unsupported script encoding UTF16-LE");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
#endif
}
break;
s = add_utf16_textfilter(s, FALSE);
}
#else
- Perl_croak(aTHX_ "Unsupported script encoding UTF16-BE");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
#endif
}
break;
if (s[1] == 0) {
if (s[2] == 0xFE && s[3] == 0xFF) {
/* UTF-32 big-endian */
- Perl_croak(aTHX_ "Unsupported script encoding UTF32-BE");
+ Perl_croak(aTHX_ "Unsupported script encoding UTF-32BE");
}
}
else if (s[2] == 0 && s[3] != 0) {
/* Leading bytes
* 00 xx 00 xx
* are a good indicator of UTF-16BE. */
+#ifndef PERL_NO_UTF16_FILTER
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
- s = add_utf16_textfilter(s, FALSE);
+ s = add_utf16_textfilter(s, FALSE);
+#else
+ Perl_croak(aTHX_ "Unsupported script encoding UTF-16BE");
+#endif
}
}
#ifdef EBCDIC
/* Leading bytes
* xx 00 xx 00
* are a good indicator of UTF-16LE. */
+#ifndef PERL_NO_UTF16_FILTER
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
s = add_utf16_textfilter(s, TRUE);
+#else
+ Perl_croak(aTHX_ "Unsupported script encoding UTF-16LE");
+#endif
}
}
return (char*)s;
https://perl5.git.perl.org / perl5.git / blobdiff