diff options
| -rw-r--r-- | pp_sort.c | 15 | ||||
| -rw-r--r-- | t/op/sort.t | 25 |
2 files changed, 35 insertions, 5 deletions
@@ -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 21a30d75c1..610db691b8 100644 --- 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]"; +} |