PERL_ARGS_ASSERT_PRINTBUF;
+ GCC_DIAG_IGNORE(-Wformat-nonliteral); /* fmt checked by caller */
PerlIO_printf(Perl_debug_log, fmt, pv_display(tmp, s, strlen(s), 0, 60));
+ GCC_DIAG_RESTORE;
SvREFCNT_dec(tmp);
}
parser->linestart = SvPVX(parser->linestr);
parser->bufend = parser->bufptr + SvCUR(parser->linestr);
parser->last_lop = parser->last_uni = NULL;
- parser->lex_flags = flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES
- |LEX_DONT_CLOSE_RSFP);
+
+ assert(FITS_IN_8_BITS(LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES
+ |LEX_DONT_CLOSE_RSFP));
+ parser->lex_flags = (U8) (flags & (LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES
+ |LEX_DONT_CLOSE_RSFP));
parser->in_pod = parser->filtered = 0;
}
*/
static int
-S_postderef(pTHX_ char const funny, char const next)
+S_postderef(pTHX_ int const funny, char const next)
{
dVAR;
- assert(strchr("$@%&*", funny));
+ assert(funny == DOLSHARP || strchr("$@%&*", funny));
assert(strchr("*[{", next));
if (next == '*') {
PL_expect = XOPERATOR;
if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) {
- assert('@' == funny || '$' == funny);
+ assert('@' == funny || '$' == funny || DOLSHARP == funny);
PL_lex_state = LEX_INTERPEND;
start_force(PL_curforce);
force_next(POSTJOIN);
PL_bufptr+=2;
}
else {
- if ('@' == funny) PL_lex_dojoin = 2;
+ if ('@' == funny && PL_lex_state == LEX_INTERPNORMAL
+ && !PL_lex_brackets)
+ PL_lex_dojoin = 2;
PL_expect = XOPERATOR;
PL_bufptr++;
}
char *s;
char *send;
char *d;
- STRLEN len = 0;
SV *pv = sv;
PERL_ARGS_ASSERT_TOKEQ;
- if (!SvLEN(sv))
- goto finish;
-
- s = SvPV_force(sv, len);
- if (SvTYPE(sv) >= SVt_PVIV && SvIVX(sv) == -1)
+ assert (SvPOK(sv));
+ assert (SvLEN(sv));
+ assert (!SvIsCOW(sv));
+ if (SvTYPE(sv) >= SVt_PVIV && SvIVX(sv) == -1) /* <<'heredoc' */
goto finish;
- send = s + len;
+ s = SvPVX(sv);
+ send = SvEND(sv);
/* This is relying on the SV being "well formed" with a trailing '\0' */
while (s < send && !(*s == '\\' && s[1] == '\\'))
s++;
goto finish;
d = s;
if ( PL_hints & HINT_NEW_STRING ) {
- pv = newSVpvn_flags(SvPVX_const(pv), len, SVs_TEMP | SvUTF8(sv));
+ pv = newSVpvn_flags(SvPVX_const(pv), SvCUR(sv),
+ SVs_TEMP | SvUTF8(sv));
}
while (s < send) {
if (*s == '\\') {
PL_lex_op = NULL;
return THING;
}
- if (op_type == OP_CONST || op_type == OP_READLINE) {
+ if (op_type == OP_CONST) {
SV *sv = tokeq(PL_lex_stuff);
if (SvTYPE(sv) == SVt_PVIV) {
}
pl_yylval.opval = (OP*)newSVOP(op_type, 0, sv);
PL_lex_stuff = NULL;
- /* Allow <FH> // "foo" */
- if (op_type == OP_READLINE)
- PL_expect = XTERMORDORDOR;
- return THING;
- }
- else if (op_type == OP_BACKTICK && PL_lex_op) {
- /* readpipe() was overridden */
- cSVOPx(cLISTOPx(cUNOPx(PL_lex_op)->op_first)->op_first->op_sibling)->op_sv = tokeq(PL_lex_stuff);
- pl_yylval.opval = PL_lex_op;
- PL_lex_op = NULL;
- PL_lex_stuff = NULL;
return THING;
}
/* Is there a right-hand side to take care of? (s//RHS/ or tr//RHS/) */
assert(PL_lex_inwhat != OP_TRANSR);
- if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
+ if (PL_lex_repl) {
+ assert (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS);
PL_linestr = PL_lex_repl;
PL_lex_inpat = 0;
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
* validation. */
table = GvHV(PL_hintgv); /* ^H */
cvp = hv_fetchs(table, "charnames", FALSE);
- if (cvp && (cv = *cvp) && SvROK(cv) && ((rv = SvRV(cv)) != NULL)
- && SvTYPE(rv) == SVt_PVCV && ((stash = CvSTASH(rv)) != NULL))
+ if (cvp && (cv = *cvp) && SvROK(cv) && (rv = SvRV(cv),
+ SvTYPE(rv) == SVt_PVCV) && ((stash = CvSTASH(rv)) != NULL))
{
const char * const name = HvNAME(stash);
- if strEQ(name, "_charnames") {
+ if (HvNAMELEN(stash) == sizeof("_charnames")-1
+ && strEQ(name, "_charnames")) {
return res;
}
}
if (PL_lex_inwhat == OP_SUBST && !PL_lex_inpat &&
isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
{
+ /* diag_listed_as: \%d better written as $%d */
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s);
*--s = '$';
break;
if (! PL_lex_inpat) {
yyerror("Missing right brace on \\N{}");
} else {
- yyerror("Missing right brace on \\N{} or unescaped left brace after \\N.");
+ yyerror("Missing right brace on \\N{} or unescaped left brace after \\N");
}
continue;
}
* It deals with "$foo[3]" and /$foo[3]/ and /$foo[0123456789$]+/
*
* ->[ and ->{ return TRUE
- * ->$* ->@* ->@[ and ->@{ return TRUE if postfix_interpolate is enabled
+ * ->$* ->$#* ->@* ->@[ ->@{ return TRUE if postderef_qq is enabled
* { and [ outside a pattern are always subscripts, so return TRUE
* if we're outside a pattern and it's not { or [, then return FALSE
* if we're in a pattern and the first char is a {
return TRUE;
if (*s == '-' && s[1] == '>'
&& FEATURE_POSTDEREF_QQ_IS_ENABLED
- && ( (s[2] == '$' && s[3] == '*')
+ && ( (s[2] == '$' && (s[3] == '*' || (s[3] == '#' && s[4] == '*')))
||(s[2] == '@' && strchr("*[{",s[3])) ))
return TRUE;
if (*s != '{' && *s != '[')
return gv_stashpvn(pkgname, len, UTF ? SVf_UTF8 : 0);
}
-/*
- * S_readpipe_override
- * Check whether readpipe() is overridden, and generates the appropriate
- * optree, provided sublex_start() is called afterwards.
- */
-STATIC void
-S_readpipe_override(pTHX)
-{
- GV **gvp;
- GV *gv_readpipe = gv_fetchpvs("readpipe", GV_NOTQUAL, SVt_PVCV);
- pl_yylval.ival = OP_BACKTICK;
- if ((gv_readpipe
- && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe))
- ||
- ((gvp = (GV**)hv_fetchs(PL_globalstash, "readpipe", FALSE))
- && (gv_readpipe = *gvp) && isGV_with_GP(gv_readpipe)
- && GvCVu(gv_readpipe) && GvIMPORTED_CV(gv_readpipe)))
- {
- COPLINE_SET_FROM_MULTI_END;
- PL_lex_op = (OP*)newUNOP(OP_ENTERSUB, OPf_STACKED,
- op_append_elem(OP_LIST,
- newSVOP(OP_CONST, 0, &PL_sv_undef), /* value will be read later */
- newCVREF(0, newGVOP(OP_GV, 0, gv_readpipe))));
- }
-}
-
#ifdef PERL_MAD
/*
* Perl_madlex
char *d;
STRLEN len;
bool bof = FALSE;
- const bool saw_infix_sigil = PL_parser->saw_infix_sigil;
+ const bool saw_infix_sigil = cBOOL(PL_parser->saw_infix_sigil);
U8 formbrack = 0;
U32 fake_eof = 0;
DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } );
OPERATOR('-'); /* unary minus */
}
- PL_last_uni = PL_oldbufptr;
switch (tmp) {
case 'r': ftst = OP_FTEREAD; break;
case 'w': ftst = OP_FTEWRITE; break;
break;
}
if (ftst) {
+ PL_last_uni = PL_oldbufptr;
PL_last_lop_op = (OPCODE)ftst;
DEBUG_T( { PerlIO_printf(Perl_debug_log,
"### Saw file test %c\n", (int)tmp);
s = SKIPSPACE1(s);
if (FEATURE_POSTDEREF_IS_ENABLED && (
((*s == '$' || *s == '&') && s[1] == '*')
+ ||(*s == '$' && s[1] == '#' && s[2] == '*')
||((*s == '@' || *s == '%') && strchr("*[{", s[1]))
||(*s == '*' && (s[1] == '*' || s[1] == '{'))
))
{
+ Perl_ck_warner_d(aTHX_
+ packWARN(WARN_EXPERIMENTAL__POSTDEREF),
+ "Postfix dereference is experimental"
+ );
PL_expect = XPOSTDEREF;
TOKEN(ARROW);
}
if ((PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s)) {
if (*s == '[')
PL_tokenbuf[0] = '@';
-
- /* Warn about % where they meant $. */
- if (*s == '[' || *s == '{') {
- if (ckWARN(WARN_SYNTAX)) {
- S_check_scalar_slice(aTHX_ s);
- }
- }
}
PL_expect = XOPERATOR;
force_ident_maybe_lex('%');
}
sv = newSVpvn_flags(s, len, UTF ? SVf_UTF8 : 0);
if (*d == '(') {
- d = scan_str(d,TRUE,TRUE,FALSE, FALSE);
+ d = scan_str(d,TRUE,TRUE,FALSE,FALSE,NULL);
COPLINE_SET_FROM_MULTI_END;
if (!d) {
/* MUST advance bufptr here to avoid bogus
TOKEN(0);
s++;
if (PL_lex_brackets <= 0)
+ /* diag_listed_as: Unmatched right %s bracket */
yyerror("Unmatched right square bracket");
else
--PL_lex_brackets;
rightbracket:
s++;
if (PL_lex_brackets <= 0)
+ /* diag_listed_as: Unmatched right %s bracket */
yyerror("Unmatched right curly bracket");
else
PL_expect = (expectation)PL_lex_brackstack[--PL_lex_brackets];
return deprecate_commaless_var_list();
}
}
- else if (PL_expect == XPOSTDEREF) POSTDEREF('$');
+ else if (PL_expect == XPOSTDEREF) {
+ if (s[1] == '#') {
+ s++;
+ POSTDEREF(DOLSHARP);
+ }
+ POSTDEREF('$');
+ }
if (s[1] == '#' && (isIDFIRST_lazy_if(s+2,UTF) || strchr("{$:+-@", s[2]))) {
PL_tokenbuf[0] = '@';
TERM(THING);
case '\'':
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
COPLINE_SET_FROM_MULTI_END;
DEBUG_T( { printbuf("### Saw string before %s\n", s); } );
if (PL_expect == XOPERATOR) {
TERM(sublex_start());
case '"':
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
DEBUG_T( {
if (s)
printbuf("### Saw string before %s\n", s);
TERM(sublex_start());
case '`':
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
DEBUG_T( { printbuf("### Saw backtick string before %s\n", s); } );
if (PL_expect == XOPERATOR)
no_op("Backticks",s);
if (!s)
missingterm(NULL);
- readpipe_override();
+ pl_yylval.ival = OP_BACKTICK;
TERM(sublex_start());
case '\\':
s++;
- if (PL_lex_inwhat && isDIGIT(*s))
+ if (PL_lex_inwhat == OP_SUBST && PL_lex_repl == PL_linestr
+ && isDIGIT(*s))
Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX),"Can't use \\%c to mean $%c in expression",
*s, *s);
if (PL_expect == XOPERATOR)
anydelim = word_takes_any_delimeter(PL_tokenbuf, len);
/* x::* is just a word, unless x is "CORE" */
- if (!anydelim && *s == ':' && s[1] == ':' && strNE(PL_tokenbuf, "CORE"))
+ if (!anydelim && *s == ':' && s[1] == ':') {
+ if (strEQ(PL_tokenbuf, "CORE")) goto case_KEY_CORE;
goto just_a_word;
+ }
d = s;
while (d < PL_bufend && isSPACE(*d))
if (PL_expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
CV *cv;
if ((gv = gv_fetchpvn_flags(PL_tokenbuf, len,
- UTF ? SVf_UTF8 : 0, SVt_PVCV)) &&
+ (UTF ? SVf_UTF8 : 0)|GV_NOTQUAL,
+ SVt_PVCV)) &&
(cv = GvCVu(gv)))
{
if (GvIMPORTED_CV(gv))
}
if (!ogv &&
(gvp = (GV**)hv_fetch(PL_globalstash, PL_tokenbuf,
- UTF ? -(I32)len : (I32)len, FALSE)) &&
- (gv = *gvp) && isGV_with_GP(gv) &&
- GvCVu(gv) && GvIMPORTED_CV(gv))
+ len, FALSE)) &&
+ (gv = *gvp) && (
+ isGV_with_GP(gv)
+ ? GvCVu(gv) && GvIMPORTED_CV(gv)
+ : SvPCS_IMPORTED(gv)
+ && (gv_init(gv, PL_globalstash, PL_tokenbuf,
+ len, 0), 1)
+ ))
{
ogv = gv;
}
}
gv = NULL;
gvp = 0;
- if (hgv && tmp != KEY_x && tmp != KEY_CORE) /* never ambiguous */
+ if (hgv && tmp != KEY_x) /* never ambiguous */
Perl_ck_warner(aTHX_ packWARN(WARN_AMBIGUOUS),
"Ambiguous call resolved as CORE::%s(), "
"qualify as such or use &",
while (isLOWER(*d))
d++;
if (!*d && !gv_stashpv(PL_tokenbuf, UTF ? SVf_UTF8 : 0))
+ {
+ /* PL_warn_reserved is constant */
+ GCC_DIAG_IGNORE(-Wformat-nonliteral);
Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved,
PL_tokenbuf);
+ GCC_DIAG_RESTORE;
+ }
}
}
}
}
goto just_a_word;
- case KEY_CORE:
- if (*s == ':' && s[1] == ':') {
+ case_KEY_CORE:
+ {
STRLEN olen = len;
d = s;
s += 2;
orig_keyword = tmp;
goto reserved_word;
}
- goto just_a_word;
case KEY_abs:
UNI(OP_ABS);
*PL_tokenbuf = '&';
d = scan_word(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1,
1, &len);
- if (len && !keyword(PL_tokenbuf + 1, len, 0)) {
+ if (len && (len != 4 || strNE(PL_tokenbuf+1, "CORE"))
+ && !keyword(PL_tokenbuf + 1, len, 0)) {
d = SKIPSPACE1(d);
if (*d == '(') {
force_ident_maybe_lex('&');
strnEQ(p, "our", 3) && isSPACE(*(p + 3)))
p += 3;
p = PEEKSPACE(p);
+ /* skip optional package name, as in "for my abc $x (..)" */
if (isIDFIRST_lazy_if(p,UTF)) {
- p = scan_ident(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE);
+ p = scan_word(p, PL_tokenbuf, sizeof PL_tokenbuf, TRUE, &len);
p = PEEKSPACE(p);
}
if (*p != '$')
case KEY_glob:
LOP(
- orig_keyword==KEY_glob ? (orig_keyword=0, -OP_GLOB) : OP_GLOB,
+ orig_keyword==KEY_glob ? -OP_GLOB : OP_GLOB,
XTERM
);
LOP(OP_PIPE_OP,XTERM);
case KEY_q:
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
COPLINE_SET_FROM_MULTI_END;
if (!s)
missingterm(NULL);
case KEY_qw: {
OP *words = NULL;
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
COPLINE_SET_FROM_MULTI_END;
if (!s)
missingterm(NULL);
}
case KEY_qq:
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
if (!s)
missingterm(NULL);
pl_yylval.ival = OP_STRINGIFY;
TERM(sublex_start());
case KEY_qx:
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
if (!s)
missingterm(NULL);
- readpipe_override();
+ pl_yylval.ival = OP_BACKTICK;
TERM(sublex_start());
case KEY_return:
/* Look for a prototype */
if (*s == '(') {
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
COPLINE_SET_FROM_MULTI_END;
if (!s)
Perl_croak(aTHX_ "Prototype not terminated");
tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
}
else {
- if (has_colon)
+ if (has_colon) {
+ /* PL_no_myglob is constant */
+ GCC_DIAG_IGNORE(-Wformat-nonliteral);
yyerror_pv(Perl_form(aTHX_ PL_no_myglob,
PL_in_my == KEY_my ? "my" : "state", PL_tokenbuf),
UTF ? SVf_UTF8 : 0);
+ GCC_DIAG_RESTORE;
+ }
pl_yylval.opval = newOP(OP_PADANY, 0);
pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
newSVpvs(":full"),
newSVpvs(":short"),
NULL);
- SPAGAIN;
+ assert(sp == PL_stack_sp);
table = GvHV(PL_hintgv);
if (table
&& (PL_hints & HINT_LOCALIZE_HH)
char *d = dest;
char * const e = d + destlen - 3; /* two-character token, ending NUL */
bool is_utf8 = cBOOL(UTF);
- I32 orig_copline, tmp_copline = 0;
+ I32 orig_copline = 0, tmp_copline = 0;
PERL_ARGS_ASSERT_SCAN_IDENT;
yyerror(Perl_form(aTHX_ "Regexp modifiers \"/%c\" and \"/%c\" are mutually exclusive", *charset, c));
}
else if (c == 'a') {
+ /* diag_listed_as: Regexp modifier "/%c" may appear a maximum of twice */
yyerror("Regexp modifier \"/a\" may appear a maximum of twice");
}
else {
PERL_ARGS_ASSERT_SCAN_PAT;
s = scan_str(start,!!PL_madskills,FALSE, (PL_in_eval & EVAL_RE_REPARSING),
- TRUE /* look for escaped bracketed metas */ );
+ TRUE /* look for escaped bracketed metas */, NULL);
if (!s) {
const char * const delimiter = skipspace(start);
#ifdef PERL_MAD
char *modstart;
#endif
+ char *t;
PERL_ARGS_ASSERT_SCAN_SUBST;
pl_yylval.ival = OP_NULL;
s = scan_str(start,!!PL_madskills,FALSE,FALSE,
- TRUE /* look for escaped bracketed metas */ );
+ TRUE /* look for escaped bracketed metas */, &t);
if (!s)
Perl_croak(aTHX_ "Substitution pattern not terminated");
- if (s[-1] == PL_multi_open)
- s--;
+ s = t;
#ifdef PERL_MAD
if (PL_madskills) {
CURMAD('q', PL_thisopen);
first_start = PL_multi_start;
first_line = CopLINE(PL_curcop);
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
if (!s) {
if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
#ifdef PERL_MAD
char *modstart;
#endif
+ char *t;
PERL_ARGS_ASSERT_SCAN_TRANS;
pl_yylval.ival = OP_NULL;
- s = scan_str(start,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(start,!!PL_madskills,FALSE,FALSE,FALSE,&t);
if (!s)
Perl_croak(aTHX_ "Transliteration pattern not terminated");
- if (s[-1] == PL_multi_open)
- s--;
+ s = t;
#ifdef PERL_MAD
if (PL_madskills) {
CURMAD('q', PL_thisopen);
}
#endif
- s = scan_str(s,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(s,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
if (!s) {
if (PL_lex_stuff) {
SvREFCNT_dec(PL_lex_stuff);
if (d - PL_tokenbuf != len) {
pl_yylval.ival = OP_GLOB;
- s = scan_str(start,!!PL_madskills,FALSE,FALSE, FALSE);
+ s = scan_str(start,!!PL_madskills,FALSE,FALSE,FALSE,NULL);
if (!s)
Perl_croak(aTHX_ "Glob not terminated");
return s;
else {
bool readline_overriden = FALSE;
GV *gv_readline;
- GV **gvp;
/* we're in a filehandle read situation */
d = PL_tokenbuf;
/* Check whether readline() is overriden */
gv_readline = gv_fetchpvs("readline", GV_NOTQUAL, SVt_PVCV);
- if ((gv_readline
- && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline))
- ||
- ((gvp = (GV**)hv_fetchs(PL_globalstash, "readline", FALSE))
- && (gv_readline = *gvp) && isGV_with_GP(gv_readline)
- && GvCVu(gv_readline) && GvIMPORTED_CV(gv_readline)))
+ if ((gv_readline = gv_override("readline",8)))
readline_overriden = TRUE;
/* if <$fh>, create the ops to turn the variable into a
deprecate_escaped_meta issue a deprecation warning for cer-
tain paired metacharacters that appear
escaped within it
+ delimp if non-null, this is set to the position of
+ the closing delimiter, or just after it if
+ the closing and opening delimiters differ
+ (i.e., the opening delimiter of a substitu-
+ tion replacement)
returns: position to continue reading from buffer
side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
updates the read buffer.
STATIC char *
S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims, int re_reparse,
- bool deprecate_escaped_meta
+ bool deprecate_escaped_meta, char **delimp
)
{
dVAR;
PL_sublex_info.repl = sv;
else
PL_lex_stuff = sv;
+ if (delimp) *delimp = PL_multi_open == PL_multi_close ? s-termlen : s;
return s;
}
https://perl5.git.perl.org / perl5.git / blobdiff