origlen, UNI_DISPLAY_ISPRINT)
: pv_pretty(tmpsv, p, origlen, 60, NULL, NULL, PERL_PV_ESCAPE_NONASCII);
+ if (curstash && !memchr(SvPVX(name), ':', SvCUR(name))) {
+ SV *name2 = sv_2mortal(newSVsv(PL_curstname));
+ sv_catpvs(name2, "::");
+ sv_catsv(name2, (SV *)name);
+ name = name2;
+ }
+
if (proto_after_greedy_proto)
Perl_warner(aTHX_ packWARN(WARN_ILLEGALPROTO),
"Prototype after '%c' for %" SVf " : %s",
/* Here, we don't think we're in a range. If the new character
* is not a hyphen; or if it is a hyphen, but it's too close to
- * either edge to indicate a range, then it's a regular
- * character. */
- if (*s != '-' || s >= send - 1 || s == start) {
+ * either edge to indicate a range, or if we haven't output any
+ * characters yet then it's a regular character. */
+ if (*s != '-' || s >= send - 1 || s == start || d == SvPVX(sv)) {
/* A regular character. Process like any other, but first
* clear any flags */
* For non-patterns, the named characters are converted to
* their string equivalents. In patterns, named characters are
* not converted to their ultimate forms for the same reasons
- * that other escapes aren't. Instead, they are converted to
- * the \N{U+...} form to get the value from the charnames that
- * is in effect right now, while preserving the fact that it
- * was a named character, so that the regex compiler knows
- * this.
+ * that other escapes aren't (mainly that the ultimate
+ * character could be considered a meta-symbol by the regex
+ * compiler). Instead, they are converted to the \N{U+...}
+ * form to get the value from the charnames that is in effect
+ * right now, while preserving the fact that it was a named
+ * character, so that the regex compiler knows this.
*
* The structure of this section of code (besides checking for
* errors and upgrading to utf8) is:
PL_parser->last_uni = buf + last_uni_pos;
if (PL_parser->last_lop)
PL_parser->last_lop = buf + last_lop_pos;
- SvLEN(linestr) = SvCUR(linestr);
- SvCUR(linestr) = s-SvPVX(linestr);
+ SvLEN_set(linestr, SvCUR(linestr));
+ SvCUR_set(linestr, s - SvPVX(linestr));
PL_parser->filtered = 1;
break;
}
0, cBOOL(UTF), FALSE);
*dest = '\0';
assert(PL_tokenbuf[1]); /* we have a variable name */
+ }
+ else {
+ *PL_tokenbuf = 0;
+ PL_in_my = 0;
+ }
+
+ s = skipspace(s);
+ /* parse the = for the default ourselves to avoid '+=' etc being accepted here
+ * as the ASSIGNOP, and exclude other tokens that start with =
+ */
+ if (*s == '=' && (!s[1] || strchr("=~>", s[1]) == 0)) {
+ /* save now to report with the same context as we did when
+ * all ASSIGNOPS were accepted */
+ PL_oldbufptr = s;
+
+ ++s;
+ NEXTVAL_NEXTTOKE.ival = 0;
+ force_next(ASSIGNOP);
+ PL_expect = XTERM;
+ }
+ else if (*s == ',' || *s == ')') {
+ PL_expect = XOPERATOR;
+ }
+ else {
+ /* make sure the context shows the unexpected character and
+ * hopefully a bit more */
+ if (*s) ++s;
+ while (*s && *s != '$' && *s != '@' && *s != '%' && *s != ')')
+ s++;
+ PL_bufptr = s; /* for error reporting */
+ yyerror("Illegal operator following parameter in a subroutine signature");
+ PL_in_my = 0;
+ }
+ if (*PL_tokenbuf) {
NEXTVAL_NEXTTOKE.ival = sigil;
force_next('p'); /* force a signature pending identifier */
}
- else
- PL_in_my = 0;
- PL_expect = XOPERATOR;
break;
case ')':
orig_keyword = 0;
lex = 0;
off = 0;
+ /* FALLTHROUGH */
default: /* not a keyword */
just_a_word: {
int pkgname = 0;
if ( !tmp_copline )
tmp_copline = CopLINE(PL_curcop);
- if ((skip = s < PL_bufend && isSPACE(*s)))
+ if ((skip = s < PL_bufend && isSPACE(*s))) {
/* Avoid incrementing line numbers or resetting PL_linestart,
in case we have to back up. */
+ STRLEN s_off = s - SvPVX(PL_linestr);
s2 = peekspace(s);
+ s = SvPVX(PL_linestr) + s_off;
+ }
else
s2 = s;
PL_multi_end = 0;
pm->op_pmflags |= PMf_EVAL;
- while (es-- > 0) {
- if (es)
- sv_catpvs(repl, "eval ");
- else
- sv_catpvs(repl, "do ");
- }
- sv_catpvs(repl, "{");
+ for (; es > 1; es--) {
+ sv_catpvs(repl, "eval ");
+ }
+ sv_catpvs(repl, "do {");
sv_catsv(repl, PL_parser->lex_sub_repl);
sv_catpvs(repl, "}");
SvREFCNT_dec(PL_parser->lex_sub_repl);
PL_parser->lex_sub_repl = repl;
- es = 1;
}
/* diag_listed_as: Unsupported script encoding %s */
Perl_croak(aTHX_ "Unsupported script encoding UTF-32LE");
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (BOM)\n");
+#endif
s += 2;
if (PL_bufend > (char*)s) {
s = add_utf16_textfilter(s, TRUE);
case 0xFE:
if (s[1] == 0xFF) { /* UTF-16 big-endian? */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (BOM)\n");
+#endif
s += 2;
if (PL_bufend > (char *)s) {
s = add_utf16_textfilter(s, FALSE);
case BOM_UTF8_FIRST_BYTE: {
const STRLEN len = sizeof(BOM_UTF8_TAIL) - 1; /* Exclude trailing NUL */
if (slen > len && memEQ(s+1, BOM_UTF8_TAIL, len)) {
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-8 script encoding (BOM)\n");
+#endif
s += len + 1; /* UTF-8 */
}
break;
* 00 xx 00 xx
* are a good indicator of UTF-16BE. */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16BE script encoding (no BOM)\n");
+#endif
s = add_utf16_textfilter(s, FALSE);
#else
/* diag_listed_as: Unsupported script encoding %s */
* xx 00 xx 00
* are a good indicator of UTF-16LE. */
#ifndef PERL_NO_UTF16_FILTER
+#ifdef DEBUGGING
if (DEBUG_p_TEST || DEBUG_T_TEST) PerlIO_printf(Perl_debug_log, "UTF-16LE script encoding (no BOM)\n");
+#endif
s = add_utf16_textfilter(s, TRUE);
#else
/* diag_listed_as: Unsupported script encoding %s */
https://perl5.git.perl.org / perl5.git / blobdiff