fix GvSV refcounting in sort

Where a sort operation passes the comparands to a comparison block in $a
and $b, it wasn't taking account of the fact that the GvSV slots in *a
and *b are refcounted.  It would write the comparands into those slots
without altering any reference counts, and end by restoring the values
those slots had to start with.  This was all fine so long as nothing
else touched those slots during the process.  But code running during
the comparison is free to write to them by "*a = \1", which does frob
the reference counts.

Fix it by switching sort to manipulate GvSV in a refcount-preserving
manner, compatible with all other operations on those slots.  Fixes
[perl #92264].

diff --git a/pp_sort.c b/pp_sort.c
index fb4e2f8..8be778e 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -981,8 +981,10 @@ PP(pp_sort)
                 /* we don't want modifications localized */
                 GvINTRO_off(PL_firstgv);
                 GvINTRO_off(PL_secondgv);
-               SAVESPTR(GvSV(PL_firstgv));
-               SAVESPTR(GvSV(PL_secondgv));
+               SAVEGENERICSV(GvSV(PL_firstgv));
+               SvREFCNT_inc(GvSV(PL_firstgv));
+               SAVEGENERICSV(GvSV(PL_secondgv));
+               SvREFCNT_inc(GvSV(PL_secondgv));
            }
 
             gimme = G_SCALAR;
@@ -1118,11 +1120,16 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     I32 result;
     PMOP * const pm = PL_curpm;
     COP * const cop = PL_curcop;
+    SV *olda, *oldb;
  
     PERL_ARGS_ASSERT_SORTCV;
 
-    GvSV(PL_firstgv) = a;
-    GvSV(PL_secondgv) = b;
+    olda = GvSV(PL_firstgv);
+    GvSV(PL_firstgv) = SvREFCNT_inc_simple_NN(a);
+    SvREFCNT_dec(olda);
+    oldb = GvSV(PL_secondgv);
+    GvSV(PL_secondgv) = SvREFCNT_inc_simple_NN(b);
+    SvREFCNT_dec(oldb);
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);

diff --git a/t/op/sort.t b/t/op/sort.t
index 21a30d7..610db69 100644 (file)
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,7 @@ BEGIN {
     set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 198);
+plan(tests => 200);
 
 # these shouldn't hang
 {
@@ -1171,3 +1171,26 @@ SKIP:
     my @out = sort { $a <=> $b } @in;
     is($out[1], "20000000000000000", "check sort order");
 }
+
+# [perl #92264] refcounting of GvSV slot of *a and *b
+{
+    my $act;
+    package ReportDestruction {
+       sub new { bless({ p => $_[1] }, $_[0]) }
+       sub DESTROY { $act .= $_[0]->{p}; }
+    }
+    $act = "";
+    my $filla = \(ReportDestruction->new("[filla]"));
+    () = sort { my $r = $a cmp $b; $act .= "0"; *a = \$$filla; $act .= "1"; $r }
+           ReportDestruction->new("[sorta]"), "foo";
+    $act .= "2";
+    $filla = undef;
+    is $act, "01[sorta]2[filla]";
+    $act = "";
+    my $fillb = \(ReportDestruction->new("[fillb]"));
+    () = sort { my $r = $a cmp $b; $act .= "0"; *b = \$$fillb; $act .= "1"; $r }
+           "foo", ReportDestruction->new("[sortb]");
+    $act .= "2";
+    $fillb = undef;
+    is $act, "01[sortb]2[fillb]";
+}