In S_sortcv_stacked(), handle @_ correctly. Fix for #72334.

Remove AvREAL from @_, and set AvALLOC when reallocating @_.
Perl · Jun 23, 2010 · 8f443ca · 8f443ca
1 parent f1c7503
commit 8f443ca
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 2 deletions.
diff --git a/pp_sort.c b/pp_sort.c
@@ -1771,8 +1771,13 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 
     PERL_ARGS_ASSERT_SORTCV_STACKED;
 
+    if (AvREAL(av)) {
+	av_clear(av);
+	AvREAL_off(av);
+	AvREIFY_on(av);
+    }
     if (AvMAX(av) < 1) {
-	SV** ary = AvALLOC(av);
+	SV **ary = AvALLOC(av);
 	if (AvARRAY(av) != ary) {
 	    AvMAX(av) += AvARRAY(av) - AvALLOC(av);
 	    AvARRAY(av) = ary;
@@ -1781,6 +1786,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 	    AvMAX(av) = 1;
 	    Renew(ary,2,SV*);
 	    AvARRAY(av) = ary;
+	    AvALLOC(av) = ary;
 	}
     }
     AvFILLp(av) = 1;

diff --git a/t/op/sort.t b/t/op/sort.t
@@ -6,7 +6,7 @@ BEGIN {
     require 'test.pl';
 }
 use warnings;
-plan( tests => 151 );
+plan( tests => 153 );
 
 # these shouldn't hang
 {
@@ -843,3 +843,13 @@ is("@b", "1 2 3 3 4 5 7", "comparison result as string");
     is("@sorted","1 2", 'overload sort result');
     is($cs, 2, 'overload string called twice');
 }
+
+fresh_perl_is('sub w ($$) {my ($l, my $r) = @_; my $v = \@_; undef @_; $l <=> $r}; print join q{ }, sort w 3, 1, 2, 0',
+             '0 1 2 3',
+             {stderr => 1, switches => ['-w']},
+             'RT #72334');
+
+fresh_perl_is('sub w ($$) {my ($l, my $r) = @_; my $v = \@_; undef @_; @_ = 0..2; $l <=> $r}; print join q{ }, sort w 3, 1, 2, 0',
+             '0 1 2 3',
+             {stderr => 1, switches => ['-w']},
+             'RT #72334');