This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In S_sortcv_stacked(), handle @_ correctly. Fix for #72334.
authorGerard Goossen <gerard@ggoossen.net>
Wed, 23 Jun 2010 15:26:58 +0000 (16:26 +0100)
committerNicholas Clark <nick@ccl4.org>
Wed, 23 Jun 2010 15:36:33 +0000 (16:36 +0100)
Remove AvREAL from @_, and set AvALLOC when reallocating @_.

pp_sort.c
t/op/sort.t

index b0f2be1..51cf216 100644 (file)
--- 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;
index 351a194..88e07ea 100644 (file)
@@ -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');