Make PL_firstgv and PL_secondgv refcounted

Otherwise freeing *a or *b in a sort block will result in a crash:

$ perl -e '@_=sort { delete $::{a}; 3 } 1..3'
Segmentation fault: 11

diff --git a/pp_sort.c b/pp_sort.c
index 1bb0cd8..e517bc4 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1656,10 +1656,14 @@ PP(pp_sort)
            CATCH_SET(TRUE);
            PUSHSTACKi(PERLSI_SORT);
            if (!hasargs && !is_xsub) {
-               SAVESPTR(PL_firstgv);
-               SAVESPTR(PL_secondgv);
-               PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
-               PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);
+               SAVEGENERICSV(PL_firstgv);
+               SAVEGENERICSV(PL_secondgv);
+               PL_firstgv = MUTABLE_GV(SvREFCNT_inc(
+                   gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV)
+               ));
+               PL_secondgv = MUTABLE_GV(SvREFCNT_inc(
+                   gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV)
+               ));
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }

diff --git a/sv.c b/sv.c
index f174b18..5bf6259 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -13845,8 +13845,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_errors          = sv_dup_inc(proto_perl->Ierrors, param);
 
     PL_sortcop         = (OP*)any_dup(proto_perl->Isortcop, proto_perl);
-    PL_firstgv         = gv_dup(proto_perl->Ifirstgv, param);
-    PL_secondgv                = gv_dup(proto_perl->Isecondgv, param);
+    PL_firstgv         = gv_dup_inc(proto_perl->Ifirstgv, param);
+    PL_secondgv                = gv_dup_inc(proto_perl->Isecondgv, param);
 
     PL_stashcache       = newHV();
 

diff --git a/t/op/sort.t b/t/op/sort.t
index 9eb3525..dd60f97 100644 (file)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 181 );
+plan( tests => 182 );
 
 # these shouldn't hang
 {
@@ -1011,3 +1011,8 @@ is $#a, 10, 'sort block modifying $a and $b';
 () = sort {
     is \$a, \$a, '[perl #78194] op return values passed to sort'; 0
 } "${\''}", "${\''}";
+
+package deletions {
+    @_=sort { delete $deletions::{a}; delete $deletions::{b}; 3 } 1..3;
+}
+pass "no crash when sort block deletes *a and *b";