rpms/perl
7
0
Fork 0
Code Issues Pull Requests Releases Activity

Fix sorting tied arrays

Browse Source
This commit is contained in:
Petr Písař 2020-03-27 16:17:38 +01:00
parent 5b4184a6e3
commit c3f620d1d8
3 changed files with 218 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
perl-5.31.8-perltie.pod-rework-example-code-so-EXTEND-is-a-no-op.patch Normal file
View File

@ -0,0 +1,67 @@
From 3eb35b099f783db0ec40f0ca9f20fd1666c54cdb Mon Sep 17 00:00:00 2001
From: Yves Orton <demerphq@gmail.com>
Date: Thu, 30 Jan 2020 09:36:37 +0100
Subject: [PATCH] perltie.pod: rework example code so EXTEND is a no-op
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Most tied array implementations can and should NO-OP the EXTEND
method, and the sample code should not conflate EXTEND with STORESIZE.
EXTEND is actually less usefully used by the core than it could be
as AvMAX() does not have an equivalent tied method. So we cannot
check if we need to extend for a tied array.
This is related to [rt.cpan.org #39196] / Issue #17496.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
pod/perltie.pod | 18 +++++++++++++-----
1 file changed, 13 insertions(+), 5 deletions(-)
diff --git a/pod/perltie.pod b/pod/perltie.pod
index 2d433e8204..1bb220691b 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -301,7 +301,7 @@ spaces so we have a little more work to do here:
croak "length of $value is greater than $self->{ELEMSIZE}";
}
# fill in the blanks
- $self->EXTEND( $index ) if $index > $self->FETCHSIZE();
+ $self->STORESIZE( $index ) if $index > $self->FETCHSIZE();
# right justify to keep element size for smaller elements
$self->{ARRAY}->[$index] = sprintf "%$self->{ELEMSIZE}s", $value;
}
@@ -351,16 +351,24 @@ X<EXTEND>
Informative call that array is likely to grow to have I<count> entries.
Can be used to optimize allocation. This method need do nothing.
-In our example, we want to make sure there are no blank (C<undef>)
-entries, so C<EXTEND> will make use of C<STORESIZE> to fill elements
-as needed:
+In our example there is no reason to implement this method, so we leave
+it as a no-op. This method is only relevant to tied array implementations
+where there is the possibility of having the allocated size of the array
+be larger than is visible to a perl programmer inspecting the size of the
+array. Many tied array implementations will have no reason to implement it.
sub EXTEND {
my $self = shift;
my $count = shift;
- $self->STORESIZE( $count );
+ # nothing to see here, move along.
}
+B<NOTE:> It is generally an error to make this equivalent to STORESIZE.
+Perl may from time to time call EXTEND without wanting to actually change
+the array size directly. Any tied array should function correctly if this
+method is a no-op, even if perhaps they might not be as efficient as they
+would if this method was implemented.
+
=item EXISTS this, key
X<EXISTS>
--
2.21.1

142
perl-5.31.8-pp_sort.c-fix-fencepost-error-in-call-to-av_extend.patch Normal file
View File

@ -0,0 +1,142 @@
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

9
perl.spec
View File

@ -318,6 +318,10 @@ Patch78: perl-5.31.8-perlio.c-make-unix-close-method-call-underlaying-lay
# in upstream after 5.31.8
Patch79: perl-5.31.8-only-install-ExtUtils-XSSymSet-man-page-on-VMS.patch
# Fix sorting tied arrays, GH#17496, in upstream after 5.31.8
Patch80: perl-5.31.8-perltie.pod-rework-example-code-so-EXTEND-is-a-no-op.patch
Patch81: perl-5.31.8-pp_sort.c-fix-fencepost-error-in-call-to-av_extend.patch
# Link XS modules to libperl.so with EU::CBuilder on Linux, bug #960048
Patch200: perl-5.16.3-Link-XS-modules-to-libperl.so-with-EU-CBuilder-on-Li.patch
@ -4383,6 +4387,8 @@ you're not running VMS, this module does nothing.
%patch77 -p1
%patch78 -p1
%patch79 -p1
%patch80 -p1
%patch81 -p1
%patch200 -p1
%patch201 -p1
@ -4455,6 +4461,8 @@ perl -x patchlevel.h \
'Fedora Patch77: Fix thread-safety of IO::Handle (GH#14816)' \
'Fedora Patch78: Close :unix PerlIO layers properly' \
'Fedora Patch79: Only install ExtUtils::XSSymSet manual page on VMS (GH#17424)' \
'Fedora Patch80: Fix sorting tied arrays (GH#17496)' \
'Fedora Patch81: Fix sorting tied arrays (GH#17496)' \
'Fedora Patch200: Link XS modules to libperl.so with EU::CBuilder on Linux' \
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
%{nil}
@ -7216,6 +7224,7 @@ popd
- Prevent from an integer overflow in POSIX::SigSet()
- Fix thread-safety of IO::Handle (GH#14816)
- Close :unix PerlIO layers properly
- Fix sorting tied arrays (GH#17496)
* Mon Mar 16 2020 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.2-452
- 5.30.2 bump (see <https://metacpan.org/pod/release/SHAY/perl-5.30.2/pod/perldelta.pod>