From 2b301921ff7682e54ab74ad30dbf2ce1c9fc24b1 Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Fri, 31 Jan 2020 15:34:48 +0100
Subject: [PATCH] pp_sort.c: fix fencepost error in call to av_extend()
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

In [rt.cpan.org #39196] issue #17496 there is a report
that Tie::File produced spurious blank lines in the file
after

    @tied= sort @tied;

it turns out that this is because Tie::File treats
EXTEND similarly to STORESIZE (which is arguably not
entirely correct, but also not that weird) coupled
with an off by one error in the calls to av_extend()
in pp_sort.

This patch fixes the fencepost error, adds some comments
to av_extend() to make it clear what it is doing, and
adds a test that EXTEND is called by this code with
correct argument.

Signed-off-by: Petr Písař <ppisar@redhat.com>
---
 av.c        | 18 ++++++++++++++++--
 pp_sort.c   |  5 +++--
 t/op/sort.t | 23 +++++++++++++++++++++--
 3 files changed, 40 insertions(+), 6 deletions(-)

diff --git a/av.c b/av.c
index 918844c376..27b2f12032 100644
--- a/av.c
+++ b/av.c
@@ -55,8 +55,13 @@ Perl_av_reify(pTHX_ AV *av)
 /*
 =for apidoc av_extend
 
-Pre-extend an array.  The C<key> is the index to which the array should be
-extended.
+Pre-extend an array so that it is capable of storing values at indexes
+C<0..key>. Thus C<av_extend(av,99)> guarantees that the array can store 100
+elements, i.e. that C<av_store(av, 0, sv)> through C<av_store(av, 99, sv)>
+on a plain array will work without any further memory allocation.
+
+If the av argument is a tied array then will call the C<EXTEND> tied
+array method with an argument of C<(key+1)>.
 
 =cut
 */
@@ -72,6 +77,15 @@ Perl_av_extend(pTHX_ AV *av, SSize_t key)
     mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied);
     if (mg) {
 	SV *arg1 = sv_newmortal();
+        /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND.
+         *
+         * The C function takes an *index* (assumes 0 indexed arrays) and ensures
+         * that the array is at least as large as the index provided.
+         *
+         * The tied array method EXTEND takes a *count* and ensures that the array
+         * is at least that many elements large. Thus we have to +1 the key when
+         * we call the tied method.
+         */
 	sv_setiv(arg1, (IV)(key + 1));
 	Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1,
 			    arg1);
diff --git a/pp_sort.c b/pp_sort.c
index 0c5efb0869..4f81aaab7e 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1067,7 +1067,8 @@ PP(pp_sort)
             for (i = 0; i < max; i++)
                 base[i] = newSVsv(base[i]);
             av_clear(av);
-            av_extend(av, max);
+            if (max)
+                av_extend(av, max-1);
             for (i=0; i < max; i++) {
                 SV * const sv = base[i];
                 SV ** const didstore = av_store(av, i, sv);
@@ -1094,7 +1095,7 @@ PP(pp_sort)
             }
             av_clear(av);
             if (max > 0) {
-                av_extend(av, max);
+                av_extend(av, max-1);
                 Copy(base, AvARRAY(av), max, SV*);
             }
             AvFILLp(av) = max - 1;
diff --git a/t/op/sort.t b/t/op/sort.t
index d201f00afd..f2e139dff0 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -7,7 +7,8 @@ BEGIN {
     set_up_inc('../lib');
 }
 use warnings;
-plan(tests => 199);
+plan(tests => 203);
+use Tie::Array; # we need to test sorting tied arrays
 
 # these shouldn't hang
 {
@@ -433,7 +434,6 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
     @a = qw(b c a); $r1 = \$a[1]; @a = sort mysort @a; $r2 = \$a[0];
     is "$$r1-$$r2-@a", "c-c-c b a", "inplace sort with function of lexical";
 
-    use Tie::Array;
     my @t;
     tie @t, 'Tie::StdArray';
 
@@ -494,6 +494,25 @@ cmp_ok($x,'eq','123',q(optimized-away comparison block doesn't take any other ar
     is ("@a", "3 4 5", "RT #128340");
 
 }
+{
+    @Tied_Array_EXTEND_Test::ISA= 'Tie::StdArray';
+    my $extend_count;
+    sub Tied_Array_EXTEND_Test::EXTEND {
+        $extend_count= $_[1];
+        return;
+    }
+    my @t;
+    tie @t, "Tied_Array_EXTEND_Test";
+    is($extend_count, undef, "test that EXTEND has not been called prior to initialization");
+    $t[0]=3;
+    $t[1]=1;
+    $t[2]=2;
+    is($extend_count, undef, "test that EXTEND has not been called during initialization");
+    @t= sort @t;
+    is($extend_count, 3, "test that EXTEND was called with an argument of 3 by pp_sort()");
+    is("@t","1 2 3","test that sorting the tied array worked even though EXTEND is a no-op");
+}
+
 
 # Test optimisations of reversed sorts. As we now guarantee stability by
 # default, # optimisations which do not provide this are bogus.
-- 
2.21.1