summaryrefslogtreecommitdiff
path: root/pp_sort.c
diff options
context:
space:
mode:
authorFather Chrysostomos <sprout@cpan.org>2012-11-20 12:28:57 -0800
committerFather Chrysostomos <sprout@cpan.org>2012-11-20 17:58:56 -0800
commit2f43ddf1ec88f1ae8e0831cd4f79063476eb175a (patch)
treebb8607d7c2d75b6429cb6b1b4dc97ccb850a437a /pp_sort.c
parentd747172a76be9b40768f912d4f23713cad29648d (diff)
downloadperl-2f43ddf1ec88f1ae8e0831cd4f79063476eb175a.tar.gz
Fix panic/crash with sort { $not_num } and fatal warnings
I caused this in 5.15.4 in commit 1aa032b25ab: $ ./miniperl -Ilib -e 'eval q|use warnings FATAL=>all=>; ()=sort{undef}1,2|' panic: illegal pad in SAVEt_FREEOP: 0x803500[0x0] at -e line 1. This panic only happens under debugging builds. But it’s worse than that: $ ./miniperl -Ilib -e 'eval { use warnings FATAL => all=>; ()=sort{undef}1,2}; my $x' Bus error It’s this piece of code in pp_sort.c that is the problem: pad = PL_curpad; PL_curpad = 0; if (PL_stack_sp != PL_stack_base + 1) { assert(PL_stack_sp == PL_stack_base); result = SvIV(&PL_sv_undef); } else result = SvIV(*PL_stack_sp); PL_curpad = pad; If SvIV dies, then PL_curpad will never be restored. That results in a panic error when the string eval exits, under debugging builds, and a crash for any subsequent pad ops, under any build. So we need to use the savestack to protect PL_curpad. To avoid the overhead most of the time, we should do this only if the result is not already a number. Sorting with a sub that has a ($$) prototype follows a different code path that contains the same logic, but it is safe in that case, because sort with a sub already localises the pad. I added tests for it anyway.
Diffstat (limited to 'pp_sort.c')
-rw-r--r--pp_sort.c16
1 files changed, 11 insertions, 5 deletions
diff --git a/pp_sort.c b/pp_sort.c
index eae20984c2..57c995ec97 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1763,10 +1763,10 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
const I32 oldsaveix = PL_savestack_ix;
const I32 oldscopeix = PL_scopestack_ix;
I32 result;
+ SV *resultsv;
PMOP * const pm = PL_curpm;
OP * const sortop = PL_op;
COP * const cop = PL_curcop;
- SV **pad;
PERL_ARGS_ASSERT_SORTCV;
@@ -1777,13 +1777,19 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
CALLRUNOPS(aTHX);
PL_op = sortop;
PL_curcop = cop;
- pad = PL_curpad; PL_curpad = 0;
if (PL_stack_sp != PL_stack_base + 1) {
assert(PL_stack_sp == PL_stack_base);
- result = SvIV(&PL_sv_undef);
+ resultsv = &PL_sv_undef;
+ }
+ else resultsv = *PL_stack_sp;
+ if (SvNIOK_nog(resultsv)) result = SvIV(resultsv);
+ else {
+ ENTER;
+ SAVEVPTR(PL_curpad);
+ PL_curpad = 0;
+ result = SvIV(resultsv);
+ LEAVE;
}
- else result = SvIV(*PL_stack_sp);
- PL_curpad = pad;
while (PL_scopestack_ix > oldscopeix) {
LEAVE;
}