This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #124097] don't let the GPs be removed out from under pp_sort
authorTony Cook <tony@develop-help.com>
Thu, 17 Dec 2015 04:14:58 +0000 (15:14 +1100)
committerTony Cook <tony@develop-help.com>
Thu, 17 Dec 2015 04:14:58 +0000 (15:14 +1100)
pp_sort() saves the SV pointers for *a and *b, if the sort block
cleared *a or *b the GP, which the pointer is stored would be freed
and the save stack processing would try to write to freed memory.

Make sure the GP lasts at least long enough for the SV slots to be
restored.  This doesn't attempt to restore *a or *b, the user chose
to clear them.

pp_sort.c
t/op/sort.t

index 64a67d8..51742f6 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1657,6 +1657,13 @@ PP(pp_sort)
                PL_secondgv = MUTABLE_GV(SvREFCNT_inc(
                    gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV)
                ));
+                /* make sure the GP isn't removed out from under us for
+                 * the SAVESPTR() */
+                save_gp(PL_firstgv, 0);
+                save_gp(PL_secondgv, 0);
+                /* we don't want modifications localized */
+                GvINTRO_off(PL_firstgv);
+                GvINTRO_off(PL_secondgv);
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }
index 3c76365..22d83a9 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 193);
+plan(tests => 195);
 
 # these shouldn't hang
 {
@@ -1127,3 +1127,14 @@ pass "no crash when sort block deletes *a and *b";
     ::is (join('-', sort f2 3,1,2,4), '1-2-3-4', "Ret: f2");
     ::is (join('-', sort f3 3,1,2,4), '1-2-3-4', "Ret: f3");
 }
+
+{
+    @a = sort{ *a=0; 1} 0..1;
+    pass "No crash when GP deleted out from under us [perl 124097]";
+
+    no warnings 'redefine';
+    # some alternative non-solutions localized modifications to *a and *b
+    sub a { 0 };
+    @a = sort { *a = sub { 1 }; $a <=> $b } 0 .. 1;
+    ok(a(), "*a wasn't localized inadvertantly");
+}