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.

diff --git a/pp_sort.c b/pp_sort.c
index eae2098..57c995e 100644 (file)
--- 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;
     }

diff --git a/t/op/sort.t b/t/op/sort.t
index 0da7a27..03d2ce1 100644 (file)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 172 );
+plan( tests => 176 );
 
 # these shouldn't hang
 {
@@ -978,3 +978,20 @@ is @x, 0, '{sort} returns empty list';
     } 5,1,3,6,0;
     is "@a", "0 1 3 5 6", "padrange and void context";
 }
+
+# Fatal warnings an sort sub returning a non-number
+# We need two evals, because the panic used to happen on scope exit.
+eval { eval { use warnings FATAL => 'all'; () = sort { undef } 1,2 } };
+is $@, "",
+  'no panic/crash with fatal warnings when sort sub returns undef';
+eval { eval { use warnings FATAL => 'all'; () = sort { "no thin" } 1,2 } };
+is $@, "",
+  'no panic/crash with fatal warnings when sort sub returns string';
+sub notdef($$) { undef }
+eval { eval { use warnings FATAL => 'all'; () = sort notdef 1,2 } };
+is $@, "",
+  'no panic/crash with fatal warnings when sort sub($$) returns undef';
+sub yarn($$) { "no thinking aloud" }
+eval { eval { use warnings FATAL => 'all'; () = sort yarn 1,2 } };
+is $@, "",
+  'no panic/crash with fatal warnings when sort sub($$) returns string';