In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/eed484f95050ad51c720521f68c6341a14bf5638?hp=22d874e2615631f6d150395ed856d7be7a9de5f2>
- Log -----------------------------------------------------------------
commit eed484f95050ad51c720521f68c6341a14bf5638
Author: Daniel Dragan <bul...@hotmail.com>
Date: Thu Nov 22 23:37:29 2012 -0500
prevent multiple evaluations of ERRSV
Remove a large amount of machine code (~4KB for me) from funcs that use
ERRSV making Perl faster and smaller by preventing multiple evaluation.
ERRSV is a macro that contains GvSVn which eventually conditionally calls
Perl_gv_add_by_type. If a SvTRUE or any other multiple evaluation macro
is used on ERRSV, the expansion will, in asm have dozens of calls to
Perl_gv_add_by_type one for each test/deref of the SV in SvTRUE. A less
severe problem exists when multiple funcs (sv_set*) in a row call, each
with ERRSV as an arg. Its recalculated then, Perl_gv_add_by_type and all.
I think ERRSV macro got the func call in commit f5fa9033b8, Perl RT #70862.
Prior to that commit it would be pure derefs I think. Saving the SV* is
still better than looking into interp->gv->gp to get the SV * after each
func call.
I received no responses to
http://www.nntp.perl.org/group/perl.perl5.porters/2012/11/msg195724.html
explaining when the SV is replaced in PL_errgv, so took a conservative
view and assumed callbacks (with Perl stack/ENTER/LEAVE/eval_*/call_*)
can change it. I also assume ERRSV will never return null, this allows a
more efficiently version of SvTRUE to be used.
In Perl_newATTRSUB_flags a wasteful copy to C stack operation with the
string was removed, and a croak_notcontext to remove push instructions to
the stack. I was not sure about the interaction between ERRSV and message
sv, I didn't change it to a more efficient (instruction wise, speed, idk)
format string combining of the not safe string and ERRSV in the croak call.
If such an optimization is done, a compiler potentially will put the not
safe string on the first, unconditionally, then check PL_in_eval, and
then jump to the croak call site, or eval ERRSV, push the SV on the C stack
then push the format string "%"SVf"%s". The C stack allocated const char
array came from commit e1ec3a884f .
In Perl_eval_pv, croak_on_error was checked first to not eval ERRSV unless
necessery. I was not sure about the side effects of using a more efficient
croak_sv instead of Perl_croak (null chars, utf8, etc) so I left a comment.
nocontext used to save an push instruction on implicit sys perl.
In S_doeval, don't open a new block to avoid large whitespace changes.
The NULL assignment should optimize away unless accidental usage of errsv
in the future happens through a code change. There might be a bug here from
commit ecad31f018 since previous a char * was derefed to check for null
char, but ERRSV will never be null, so "Unknown error\n" branch will never
be taken.
For pp_sys.c, in pp_die a new block was opened to not eval ERRSV if
"well-formed exception supplied". The else if else if else blocks all used
ERRSV, so a "SV * errsv = NULL;" and a eval in the conditional with comma
op thing wouldn't work (maybe it would, see toke.c comments later in this
message). pp_warn, I have no comments.
In S_compile_runtime_code, a croak_sv question comes up same as in
Perl_eval_pv.
In S_new_constant, a eval in the conditional is done to avoid evaling
ERRSV if PL_in_eval short circuits. Same thing in Perl_yyerror_pvn.
Perl__core_swash_init I have no comments.
In the future, a SvEMPTYSTRING macro should be considered (not fully
thought out by me) to replace the SvTRUEs with something smaller and
faster when dealing with ERRSV. _nomg is another thing to think about.
In S_init_main_stash there is an opportunity to prevent an extra ERRSV
between "sv_grow(ERRSV, 240);" and "CLEAR_ERRSV();" that was too complicated
for me to optimize.
before perl517.dll
.text 0xc2f77
.rdata 0x212dc
.data 0x3948
after perl517.dll
.text 0xc20d7
.rdata 0x212dc
.data 0x3948
Numbers are from VC 2003 x86 32 bit.
M mg.c
M op.c
M perl.c
M pp_ctl.c
M pp_sys.c
M regcomp.c
M toke.c
M utf8.c
commit b99c9e9a2fb2fff6d70f66d59c376cf258e2c047
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 22 19:18:57 2012 -0800
sv.c:S_curse: move assertions to make them useful
I added these when debugging something, and decided to keep them, as
they could be useful. So I committed them as 14eebc59.
But now I realise that they are quite useless where they are, as a
program will crash before the failed assertions are reached.
M sv.c
commit 4b748257c65d0cf78771db569a081f98eb77c7fa
Author: Father Chrysostomos <spr...@cpan.org>
Date: Thu Nov 22 14:53:47 2012 -0800
sv.c:S_curse: remove unnecessary null check
If an SV has the OBJECT flag on but no STASH, it will cause crashes
elsewhere. So there has to be a stash here. I only put the null
check there in 8c34e50dc because I was copying what StashHANDLER
used to do. 8c34e50dc removed the use of StashHANDLER (which calls
gv_handler, which has a null check), replacing it with a different
caching mechanism inlined into S_curse.
M sv.c
commit 38b1111c5f4e6340ce434a21336fe7350c148b03
Author: Father Chrysostomos <spr...@cpan.org>
Date: Wed Nov 21 22:52:14 2012 -0800
svleak.t: To-do tests for fatal warnings and some syntax errs
M t/op/svleak.t
-----------------------------------------------------------------------
Summary of changes:
mg.c | 37 +++++++++++++++++--------------
op.c | 9 +++----
perl.c | 8 +++++-
pp_ctl.c | 16 ++++++++-----
pp_sys.c | 66 ++++++++++++++++++++++++++++++--------------------------
regcomp.c | 10 ++++++--
sv.c | 8 ++++--
t/op/svleak.t | 51 +++++++++++++++++++++++++++++++++++++++++++-
toke.c | 12 ++++++----
utf8.c | 14 ++++++++---
10 files changed, 154 insertions(+), 77 deletions(-)
diff --git a/mg.c b/mg.c
index 761bf73..2d063db 100644
--- a/mg.c
+++ b/mg.c
@@ -3139,8 +3139,10 @@ Perl_sighandler(int sig)
call_sv(MUTABLE_SV(cv), G_DISCARD|G_EVAL);
POPSTACK;
- if (SvTRUE(ERRSV)) {
- SvREFCNT_dec(errsv_save);
+ {
+ SV * const errsv = ERRSV;
+ if (SvTRUE_NN(errsv)) {
+ SvREFCNT_dec(errsv_save);
#ifndef PERL_MICRO
/* Handler "died", for example to get out of a restart-able read().
* Before we re-do that on its behalf re-enable the signal which was
@@ -3148,25 +3150,26 @@ Perl_sighandler(int sig)
*/
#ifdef HAS_SIGPROCMASK
#if defined(HAS_SIGACTION) && defined(SA_SIGINFO)
- if (sip || uap)
+ if (sip || uap)
#endif
- {
- sigset_t set;
- sigemptyset(&set);
- sigaddset(&set,sig);
- sigprocmask(SIG_UNBLOCK, &set, NULL);
- }
+ {
+ sigset_t set;
+ sigemptyset(&set);
+ sigaddset(&set,sig);
+ sigprocmask(SIG_UNBLOCK, &set, NULL);
+ }
#else
- /* Not clear if this will work */
- (void)rsignal(sig, SIG_IGN);
- (void)rsignal(sig, PL_csighandlerp);
+ /* Not clear if this will work */
+ (void)rsignal(sig, SIG_IGN);
+ (void)rsignal(sig, PL_csighandlerp);
#endif
#endif /* !PERL_MICRO */
- die_sv(ERRSV);
- }
- else {
- sv_setsv(ERRSV, errsv_save);
- SvREFCNT_dec(errsv_save);
+ die_sv(errsv);
+ }
+ else {
+ sv_setsv(errsv, errsv_save);
+ SvREFCNT_dec(errsv_save);
+ }
}
cleanup:
diff --git a/op.c b/op.c
index 23f7aff..1b4cf8d 100644
--- a/op.c
+++ b/op.c
@@ -7379,14 +7379,13 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP
*proto, OP *attrs,
const char *s = strrchr(name, ':');
s = s ? s+1 : name;
if (strEQ(s, "BEGIN")) {
- const char not_safe[] =
- "BEGIN not safe after errors--compilation aborted";
if (PL_in_eval & EVAL_KEEPERR)
- Perl_croak(aTHX_ not_safe);
+ Perl_croak_nocontext("BEGIN not safe after
errors--compilation aborted");
else {
+ SV * const errsv = ERRSV;
/* force display of errors found but not reported */
- sv_catpv(ERRSV, not_safe);
- Perl_croak(aTHX_ "%"SVf, SVfARG(ERRSV));
+ sv_catpvs(errsv, "BEGIN not safe after errors--compilation
aborted");
+ Perl_croak_nocontext("%"SVf, SVfARG(errsv));
}
}
}
diff --git a/perl.c b/perl.c
index 6d98d34..6236207 100644
--- a/perl.c
+++ b/perl.c
@@ -2905,8 +2905,12 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
PUTBACK;
}
- if (croak_on_error && SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV));
+ /* just check empty string or undef? */
+ if (croak_on_error) {
+ SV * const errsv = ERRSV;
+ if(SvTRUE_NN(errsv))
+ /* replace with croak_sv? */
+ Perl_croak_nocontext("%s", SvPV_nolen_const(errsv));
}
return sv;
diff --git a/pp_ctl.c b/pp_ctl.c
index 24eac16..c9e4ac4 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3445,6 +3445,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
PERL_CONTEXT *cx;
I32 optype; /* Used by POPEVAL. */
SV *namesv;
+ SV *errsv = NULL;
cx = NULL;
namesv = NULL;
@@ -3467,6 +3468,7 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
LEAVE_with_name("eval"); /* pp_entereval knows about this LEAVE. */
}
+ errsv = ERRSV;
if (in_require) {
if (!cx) {
/* If cx is still NULL, it means that we didn't go in the
@@ -3480,13 +3482,13 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
SvUTF8(namesv) ? -(I32)SvCUR(namesv) :
(I32)SvCUR(namesv),
&PL_sv_undef, 0);
Perl_croak(aTHX_ "%"SVf"Compilation failed in require",
- SVfARG(ERRSV
- ? ERRSV
+ SVfARG(errsv
+ ? errsv
: newSVpvs_flags("Unknown error\n",
SVs_TEMP)));
}
else {
- if (!*(SvPVx_nolen_const(ERRSV))) {
- sv_setpvs(ERRSV, "Compilation error");
+ if (!*(SvPV_nolen_const(errsv))) {
+ sv_setpvs(errsv, "Compilation error");
}
}
if (gimme != G_ARRAY) PUSHs(&PL_sv_undef);
@@ -5367,8 +5369,10 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
if (SvOK(out)) {
status = SvIV(out);
}
- else if (SvTRUE(ERRSV)) {
- err = newSVsv(ERRSV);
+ else {
+ SV * const errsv = ERRSV;
+ if (SvTRUE_NN(errsv))
+ err = newSVsv(errsv);
}
}
diff --git a/pp_sys.c b/pp_sys.c
index 5945e23..06699d9 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -445,17 +445,18 @@ PP(pp_warn)
/* well-formed exception supplied */
}
else {
- SvGETMAGIC(ERRSV);
- if (SvROK(ERRSV)) {
- if (SvGMAGICAL(ERRSV)) {
+ SV * const errsv = ERRSV;
+ SvGETMAGIC(errsv);
+ if (SvROK(errsv)) {
+ if (SvGMAGICAL(errsv)) {
exsv = sv_newmortal();
- sv_setsv_nomg(exsv, ERRSV);
+ sv_setsv_nomg(exsv, errsv);
}
- else exsv = ERRSV;
+ else exsv = errsv;
}
- else if (SvPOKp(ERRSV) ? SvCUR(ERRSV) : SvNIOKp(ERRSV)) {
+ else if (SvPOKp(errsv) ? SvCUR(errsv) : SvNIOKp(errsv)) {
exsv = sv_newmortal();
- sv_setsv_nomg(exsv, ERRSV);
+ sv_setsv_nomg(exsv, errsv);
sv_catpvs(exsv, "\t...caught");
}
else {
@@ -489,32 +490,35 @@ PP(pp_die)
if (SvROK(exsv) || (SvPV_const(exsv, len), len)) {
/* well-formed exception supplied */
}
- else if (SvROK(ERRSV)) {
- exsv = ERRSV;
- if (sv_isobject(exsv)) {
- HV * const stash = SvSTASH(SvRV(exsv));
- GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
- if (gv) {
- SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
- SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
- EXTEND(SP, 3);
- PUSHMARK(SP);
- PUSHs(exsv);
- PUSHs(file);
- PUSHs(line);
- PUTBACK;
- call_sv(MUTABLE_SV(GvCV(gv)),
- G_SCALAR|G_EVAL|G_KEEPERR);
- exsv = sv_mortalcopy(*PL_stack_sp--);
+ else {
+ SV * const errsv = ERRSV;
+ if (SvROK(errsv)) {
+ exsv = errsv;
+ if (sv_isobject(exsv)) {
+ HV * const stash = SvSTASH(SvRV(exsv));
+ GV * const gv = gv_fetchmethod(stash, "PROPAGATE");
+ if (gv) {
+ SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0));
+ SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop)));
+ EXTEND(SP, 3);
+ PUSHMARK(SP);
+ PUSHs(exsv);
+ PUSHs(file);
+ PUSHs(line);
+ PUTBACK;
+ call_sv(MUTABLE_SV(GvCV(gv)),
+ G_SCALAR|G_EVAL|G_KEEPERR);
+ exsv = sv_mortalcopy(*PL_stack_sp--);
+ }
}
}
- }
- else if (SvPV_const(ERRSV, len), len) {
- exsv = sv_mortalcopy(ERRSV);
- sv_catpvs(exsv, "\t...propagated");
- }
- else {
- exsv = newSVpvs_flags("Died", SVs_TEMP);
+ else if (SvPV_const(errsv, len), len) {
+ exsv = sv_mortalcopy(errsv);
+ sv_catpvs(exsv, "\t...propagated");
+ }
+ else {
+ exsv = newSVpvs_flags("Died", SVs_TEMP);
+ }
}
return die_sv(exsv);
}
diff --git a/regcomp.c b/regcomp.c
index 8b7c84c..24186e0 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -5095,10 +5095,14 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const
pRExC_state,
SPAGAIN;
qr_ref = POPs;
PUTBACK;
- if (SvTRUE(ERRSV))
{
- Safefree(pRExC_state->code_blocks);
- Perl_croak(aTHX_ "%s", SvPVx_nolen_const(ERRSV));
+ SV * const errsv = ERRSV;
+ if (SvTRUE_NN(errsv))
+ {
+ Safefree(pRExC_state->code_blocks);
+ /* use croak_sv ? */
+ Perl_croak_nocontext("%s", SvPV_nolen_const(errsv));
+ }
}
assert(SvROK(qr_ref));
qr = SvRV(qr_ref);
diff --git a/sv.c b/sv.c
index 5ecfbeb5..6a6de93 100644
--- a/sv.c
+++ b/sv.c
@@ -6332,9 +6332,10 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
dSP;
HV* stash;
do {
- if ((stash = SvSTASH(sv)) && HvNAME(stash)) {
+ stash = SvSTASH(sv);
+ assert(SvTYPE(stash) == SVt_PVHV);
+ if (HvNAME(stash)) {
CV* destructor = NULL;
- assert(SvTYPE(stash) == SVt_PVHV);
if (!SvOBJECT(stash)) destructor = (CV *)SvSTASH(stash);
if (!destructor) {
GV * const gv =
@@ -6344,6 +6345,8 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
SvSTASH(stash) =
destructor ? (HV *)destructor : ((HV *)0)+1;
}
+ assert(!destructor || destructor == ((CV *)0)+1
+ || SvTYPE(destructor) == SVt_PVCV);
if (destructor && destructor != ((CV *)0)+1
/* A constant subroutine can have no side effects, so
don't bother calling it. */
@@ -6363,7 +6366,6 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) {
)
{
SV* const tmpref = newRV(sv);
- assert(SvTYPE(destructor) == SVt_PVCV);
SvREADONLY_on(tmpref); /* DESTROY() could be naughty */
ENTER;
PUSHSTACKi(PERLSI_DESTROY);
diff --git a/t/op/svleak.t b/t/op/svleak.t
index d15a72f..2a2e31c 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
use Config;
-plan tests => 77;
+plan tests => 107;
# run some code N times. If the number of SVs at the end of loop N is
# greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -69,6 +69,45 @@ leak(5, 0, sub {}, "basic check 1 of leak
test infrastructure");
leak(5, 0, sub {push @a,1;pop @a}, "basic check 2 of leak test
infrastructure");
leak(5, 1, sub {push @a,1;}, "basic check 3 of leak test
infrastructure");
+# Fatal warnings
+my $f = "use warnings FATAL =>";
+my $all = "$f 'all';";
+$::TODO = 'still leaks';
+eleak(2, 0, "$f 'deprecated'; qq|\\c\{|", 'qq|\c{| with fatal warnings');
+eleak(2, 0, "$f 'syntax'; qq|\\c`|", 'qq|\c`| with fatal warnings');
+eleak(2, 0, "$all /\$\\ /", '/$\ / with fatal warnings');
+eleak(2, 0, "$all s//\\1/", 's//\1/ with fatal warnings');
+eleak(2, 0, "$all qq|\\i|", 'qq|\i| with fatal warnings');
+eleak(2, 0, "$f 'digit'; qq|\\o{9}|", 'qq|\o{9}| with fatal warnings');
+eleak(2, 0, "$f 'misc'; sub foo{} sub foo:lvalue",
+ 'ignored :lvalue with fatal warnings');
+eleak(2, 0, "no warnings; use feature ':all'; $f 'misc';
+ my sub foo{} sub foo:lvalue",
+ 'ignored mysub :lvalue with fatal warnings');
+eleak(2, 0, "no warnings; use feature ':all'; $all
+ my sub foo{} sub foo:lvalue{}",
+ 'fatal mysub redef warning');
+eleak(2, 0, "$all sub foo{} sub foo{}", 'fatal sub redef warning');
+eleak(2, 0, "$all *x=sub {}",
+ 'fatal sub redef warning with sub-to-glob assignment');
+eleak(2, 0, "$all *x=sub() {1}",
+ 'fatal const sub redef warning with sub-to-glob assignment');
+eleak(2, 0, "$all XS::APItest::newCONSTSUB(\\%main::=>name=>0=>1)",
+ 'newXS sub redefinition with fatal warnings');
+eleak(2, 0, "$f 'misc'; my\$a,my\$a", 'double my with fatal warnings');
+eleak(2, 0, "$f 'misc'; our\$a,our\$a", 'double our with fatal warnings');
+eleak(2, 0, "$f 'closure';
+ sub foo { my \$x; format=\n\@\n\$x\n.\n} write; ",
+ 'write beyond end of page with fatal warnings');
+eleak(2, 0, "$all /(?{})?/ ", '(?{})? with fatal warnings');
+eleak(2, 0, "$all /(?{})+/ ", '(?{})+ with fatal warnings');
+eleak(2, 0, "$all /[\\i]/ ", 'invalid charclass escape with fatal warns');
+eleak(2, 0, "$all /[:foo:]/ ", '/[:foo:]/ with fatal warnings');
+eleak(2, 0, "$all /[a-\\d]/ ", '[a-\d] char class with fatal warnings');
+eleak(2, 0, "$all v111111111111111111111111111111111111111111111111",
+ 'vstring num overflow with fatal warnings');
+undef $::TODO;
+
eleak(2, 0, 'sub{<*>}');
eleak(2, 0, 'goto sub {}', 'goto &sub in eval');
@@ -233,6 +272,16 @@ eleak(2, 0, 'no warnings; 2 2;BEGIN{}',
}
eleak(2, 0, "\"\$\0\356\"", 'qq containing $ <null> something');
eleak(2, 0, 'END OF TERMS AND CONDITIONS', 'END followed by words');
+$::TODO = 'still leaks';
+eleak(2, 0, "qq|\\c|;"x10, '"too many errors" from qq"\c"');
+eleak(2, 0, "qq|\\N{%}|"x10, '"too many errors" from qq"\N{%}"');
+eleak(2, 0, "qq|\\o|;"x10, '"too many errors" from qq"\o"');
+eleak(2, 0, "qq|\\x{|;"x10, '"too many errors" from qq"\x{"');
+eleak(2, 0, "qq|\\N|;"x10, '"too many errors" from qq"\N"');
+eleak(2, 0, "qq|\\N{|;"x10, '"too many errors" from qq"\N{"');
+eleak(2, 0, "qq|\\N{U+GETG}|;"x10,'"too many errors" from qq"\N{U+JUNK}"');
+eleak(2, 0, "qq|\\N{au}|;"x10, '"too many errors" from qq"\N{invalid}"');
+undef $::TODO;
# [perl #114764] Attributes leak scalars
diff --git a/toke.c b/toke.c
index a7c9ca5..902f83c 100644
--- a/toke.c
+++ b/toke.c
@@ -9019,6 +9019,7 @@ S_new_constant(pTHX_ const char *s, STRLEN len, const
char *key, STRLEN keylen,
dVAR; dSP;
HV * table = GvHV(PL_hintgv); /* ^H */
SV *res;
+ SV *errsv = NULL;
SV **cvp;
SV *cv, *typesv;
const char *why1 = "", *why2 = "", *why3 = "";
@@ -9112,11 +9113,11 @@ now_ok:
SPAGAIN ;
/* Check the eval first */
- if (!PL_in_eval && SvTRUE(ERRSV)) {
+ if (!PL_in_eval && ((errsv = ERRSV), SvTRUE_NN(errsv))) {
STRLEN errlen;
const char * errstr;
- sv_catpvs(ERRSV, "Propagated");
- errstr = SvPV_const(ERRSV, errlen);
+ sv_catpvs(errsv, "Propagated");
+ errstr = SvPV_const(errsv, errlen);
yyerror_pvn(errstr, errlen, 0); /* Duplicates the message inside eval */
(void)POPs;
res = SvREFCNT_inc_simple(sv);
@@ -11264,9 +11265,10 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN
len, U32 flags)
else
qerror(msg);
if (PL_error_count >= 10) {
- if (PL_in_eval && SvCUR(ERRSV))
+ SV * errsv;
+ if (PL_in_eval && ((errsv = ERRSV), SvCUR(errsv)))
Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
- SVfARG(ERRSV), OutCopFILE(PL_curcop));
+ SVfARG(errsv), OutCopFILE(PL_curcop));
else
Perl_croak(aTHX_ "%s has too many errors.\n",
OutCopFILE(PL_curcop));
diff --git a/utf8.c b/utf8.c
index 5621317..b380cd2 100644
--- a/utf8.c
+++ b/utf8.c
@@ -2863,8 +2863,11 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char*
name, SV *listsv, I32 m
#endif
Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, newSVpvn(pkg,pkg_len),
NULL);
- if (!SvTRUE(ERRSV))
- sv_setsv(ERRSV, errsv_save);
+ {
+ SV * const errsv = ERRSV;
+ if (!SvTRUE_NN(errsv))
+ sv_setsv(errsv, errsv_save);
+ }
LEAVE;
}
SPAGAIN;
@@ -2887,8 +2890,11 @@ Perl__core_swash_init(pTHX_ const char* pkg, const char*
name, SV *listsv, I32 m
retval = *PL_stack_sp--;
SvREFCNT_inc(retval);
}
- if (!SvTRUE(ERRSV))
- sv_setsv(ERRSV, errsv_save);
+ {
+ SV * const errsv = ERRSV;
+ if (!SvTRUE_NN(errsv))
+ sv_setsv(errsv, errsv_save);
+ }
LEAVE;
POPSTACK;
if (IN_PERL_COMPILETIME) {
--
Perl5 Master Repository
