}
/*
-=for apidoc Amx|void|lex_stuff_pvn|char *pv|STRLEN len|U32 flags
+=for apidoc Amx|void|lex_stuff_pvn|const char *pv|STRLEN len|U32 flags
Insert characters into the lexer buffer (L</PL_parser-E<gt>linestr>),
immediately after the current lexing point (L</PL_parser-E<gt>bufptr>),
*/
void
-Perl_lex_stuff_pvn(pTHX_ char *pv, STRLEN len, U32 flags)
+Perl_lex_stuff_pvn(pTHX_ const char *pv, STRLEN len, U32 flags)
{
dVAR;
char *bufptr;
goto plain_copy;
} else {
STRLEN highhalf = 0;
- char *p, *e = pv+len;
+ const char *p, *e = pv+len;
for (p = pv; p != e; p++)
highhalf += !!(((U8)*p) & 0x80);
if (!highhalf)
lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len+highhalf);
bufptr = PL_parser->bufptr;
Move(bufptr, bufptr+len+highhalf, PL_parser->bufend+1-bufptr, char);
+ SvCUR_set(PL_parser->linestr,
+ SvCUR(PL_parser->linestr) + len+highhalf);
PL_parser->bufend += len+highhalf;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
} else {
if (flags & LEX_STUFF_UTF8) {
STRLEN highhalf = 0;
- char *p, *e = pv+len;
+ const char *p, *e = pv+len;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
if (c >= 0xc4) {
lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len-highhalf);
bufptr = PL_parser->bufptr;
Move(bufptr, bufptr+len-highhalf, PL_parser->bufend+1-bufptr, char);
+ SvCUR_set(PL_parser->linestr,
+ SvCUR(PL_parser->linestr) + len-highhalf);
PL_parser->bufend += len-highhalf;
for (p = pv; p != e; p++) {
U8 c = (U8)*p;
lex_grow_linestr(SvCUR(PL_parser->linestr)+1+len);
bufptr = PL_parser->bufptr;
Move(bufptr, bufptr+len, PL_parser->bufend+1-bufptr, char);
+ SvCUR_set(PL_parser->linestr, SvCUR(PL_parser->linestr) + len);
PL_parser->bufend += len;
Copy(pv, bufptr, len, char);
}
Normally it is not necessarily to do this directly, because it suffices to
use the implicit discarding behaviour of L</lex_next_chunk> and things
based on it. However, if a token stretches across multiple lines,
-and the lexing code has kept multiple lines of text in the buffer fof
+and the lexing code has kept multiple lines of text in the buffer for
that purpose, then after completion of the token it would be wise to
explicitly discard the now-unneeded earlier lines, to avoid future
multi-line tokens growing the buffer without bound.
curmad('X', newSVpvn(s,d-s));
}
#endif
- if (*d == ';' || isSPACE(*d) || *d == '}' || !*d) {
+ if (*d == ';' || isSPACE(*d) || *d == '{' || *d == '}' || !*d) {
SV *ver;
#ifdef USE_LOCALE_NUMERIC
char *loc = setlocale(LC_NUMERIC, "C");
s = (char *)scan_version(s, ver, 0);
version = newSVOP(OP_CONST, 0, ver);
}
- else if ( (*s != ';' && *s != '}' ) && (s = SKIPSPACE1(s), (*s != ';' && *s !='}' ))) {
+ else if ( (*s != ';' && *s != '{' && *s != '}' ) &&
+ (s = SKIPSPACE1(s), (*s != ';' && *s != '{' && *s != '}' )))
+ {
PL_bufptr = s;
if (errstr)
yyerror(errstr); /* version required */
}
}
if (problematic) {
- char *string;
- Newx(string, e - i + 1, char);
- Copy(i, string, e - i, char);
- string[e - i] = '\0';
+ /* The e-i passed to the final %.*s makes sure that
+ * should the trailing NUL be missing that this
+ * print won't run off the end of the string */
Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
- "Deprecated character(s) in \\N{...} starting at '%s'",
- string);
- Safefree(string);
+ "Deprecated character in \\N{...}; marked by <-- HERE in \\N{%.*s<-- HERE %.*s", i - s + 1, s, e - i, i + 1);
}
}
} /* End \N{NAME} */
case 'c':
s++;
if (s < send) {
- U8 c = *s++;
-#ifdef EBCDIC
- if (isLOWER(c))
- c = toUPPER(c);
-#endif
- *d++ = NATIVE_TO_NEED(has_utf8,toCTRL(c));
+ *d++ = grok_bslash_c(*s++, 1);
}
else {
yyerror("Missing control char name in \\c");
}
}
- if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-", s[2]))) {
+ if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) {
PL_tokenbuf[0] = '@';
s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, FALSE);
/* Is this a label? */
if (!anydelim && PL_expect == XSTATE
&& d < PL_bufend && *d == ':' && *(d + 1) != ':') {
- if (tmp)
- Perl_croak(aTHX_ "Can't use keyword '%s' as a label", PL_tokenbuf);
s = d + 1;
pl_yylval.pval = CopLABEL_alloc(PL_tokenbuf);
CLINE;
s = force_word(s,WORD,FALSE,TRUE,FALSE);
s = SKIPSPACE1(s);
s = force_strict_version(s);
+ PL_lex_expect = XBLOCK;
OPERATOR(PACKAGE);
case KEY_pipe:
pl_yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpvn(PL_tokenbuf + 1,
tokenbuf_len - 1));
pl_yylval.opval->op_private = OPpCONST_ENTERED;
- gv_fetchpvn_flags(
- PL_tokenbuf + 1, tokenbuf_len - 1,
- /* If the identifier refers to a stash, don't autovivify it.
- * Change 24660 had the side effect of causing symbol table
- * hashes to always be defined, even if they were freshly
- * created and the only reference in the entire program was
- * the single statement with the defined %foo::bar:: test.
- * It appears that all code in the wild doing this actually
- * wants to know whether sub-packages have been loaded, so
- * by avoiding auto-vivifying symbol tables, we ensure that
- * defined %foo::bar:: continues to be false, and the existing
- * tests still give the expected answers, even though what
- * they're actually testing has now changed subtly.
- */
- (*PL_tokenbuf == '%'
- && *(d = PL_tokenbuf + tokenbuf_len - 1) == ':'
- && d[-1] == ':'
- ? 0
- : PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD),
- ((PL_tokenbuf[0] == '$') ? SVt_PV
- : (PL_tokenbuf[0] == '@') ? SVt_PVAV
- : SVt_PVHV));
+ gv_fetchpvn_flags(PL_tokenbuf+1, tokenbuf_len - 1,
+ PL_in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : GV_ADD,
+ ((PL_tokenbuf[0] == '$') ? SVt_PV
+ : (PL_tokenbuf[0] == '@') ? SVt_PVAV
+ : SVt_PVHV));
return WORD;
}
return pmfl;
}
-void
-Perl_pmflag(pTHX_ U32* pmfl, int ch)
-{
- PERL_ARGS_ASSERT_PMFLAG;
-
- Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
- "Perl_pmflag() is deprecated, and will be removed from the XS API");
-
- if (ch<256) {
- *pmfl = S_pmflag(*pmfl, (char)ch);
- }
-}
-
STATIC char *
S_scan_pat(pTHX_ char *start, I32 type)
{
SV *const utf16_buffer = MUTABLE_SV(IoTOP_GV(filter));
SV *const utf8_buffer = filter;
IV status = IoPAGE(filter);
- const bool reverse = (bool) IoLINES(filter);
+ const bool reverse = cBOOL(IoLINES(filter));
I32 retval;
/* As we're automatically added, at the lowest level, and hence only called
https://perl5.git.perl.org / perl5.git / blobdiff