mirror of
https://github.com/Perl/perl5.git
synced 2026-01-26 16:39:36 +00:00
Avoid redundant copies in string evals
Perl_lex_start copies the string passed to it unconditionally. Sometimes pp_entereval makes a copy before passing the string to lex_start. So in those cases we can pass a flag to avoid a redundant copy.
This commit is contained in:
parent
bc34412328
commit
0abcdfa4c5
4
parser.h
4
parser.h
@ -119,8 +119,10 @@ typedef struct yy_parser {
|
||||
# define LEX_START_SAME_FILTER 0x00000001
|
||||
# define LEX_IGNORE_UTF8_HINTS 0x00000002
|
||||
# define LEX_EVALBYTES 0x00000004
|
||||
# define LEX_START_COPIED 0x00000008
|
||||
# define LEX_START_FLAGS \
|
||||
(LEX_START_SAME_FILTER|LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES)
|
||||
(LEX_START_SAME_FILTER|LEX_START_COPIED \
|
||||
|LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES)
|
||||
#endif
|
||||
|
||||
/* flags for parser API */
|
||||
|
||||
7
pp_ctl.c
7
pp_ctl.c
@ -4125,7 +4125,7 @@ PP(pp_entereval)
|
||||
char *tmpbuf = tbuf;
|
||||
STRLEN len;
|
||||
CV* runcv;
|
||||
U32 seq;
|
||||
U32 seq, lex_flags = 0;
|
||||
HV *saved_hh = NULL;
|
||||
const bool bytes = PL_op->op_private & OPpEVAL_BYTES;
|
||||
|
||||
@ -4148,6 +4148,7 @@ PP(pp_entereval)
|
||||
const char * const p = SvPV_const(sv, len);
|
||||
|
||||
sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
|
||||
lex_flags |= LEX_START_COPIED;
|
||||
|
||||
if (bytes && SvUTF8(sv))
|
||||
SvPVbyte_force(sv, len);
|
||||
@ -4157,15 +4158,17 @@ PP(pp_entereval)
|
||||
STRLEN len;
|
||||
sv = newSVsv(sv);
|
||||
SvPVbyte_force(sv,len);
|
||||
lex_flags |= LEX_START_COPIED;
|
||||
}
|
||||
|
||||
TAINT_IF(SvTAINTED(sv));
|
||||
TAINT_PROPER("eval");
|
||||
|
||||
ENTER_with_name("eval");
|
||||
lex_start(sv, NULL, PL_op->op_private & OPpEVAL_UNICODE
|
||||
lex_start(sv, NULL, lex_flags | (PL_op->op_private & OPpEVAL_UNICODE
|
||||
? LEX_IGNORE_UTF8_HINTS
|
||||
: bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER
|
||||
)
|
||||
);
|
||||
SAVETMPS;
|
||||
|
||||
|
||||
13
toke.c
13
toke.c
@ -726,16 +726,13 @@ Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, U32 flags)
|
||||
|
||||
if (line) {
|
||||
s = SvPV_const(line, len);
|
||||
} else {
|
||||
len = 0;
|
||||
}
|
||||
|
||||
if (!len) {
|
||||
parser->linestr = newSVpvs("\n;");
|
||||
} else {
|
||||
parser->linestr = newSVpvn_flags(s, len, SvUTF8(line));
|
||||
parser->linestr = flags & LEX_START_COPIED
|
||||
? SvREFCNT_inc_simple_NN(line)
|
||||
: newSVpvn_flags(s, len, SvUTF8(line));
|
||||
if (s[len-1] != ';')
|
||||
sv_catpvs(parser->linestr, "\n;");
|
||||
} else {
|
||||
parser->linestr = newSVpvs("\n;");
|
||||
}
|
||||
parser->oldoldbufptr =
|
||||
parser->oldbufptr =
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user