Fix sorting tied arrays
This commit is contained in:
parent
5b4184a6e3
commit
c3f620d1d8
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -318,6 +318,10 @@ Patch78: perl-5.31.8-perlio.c-make-unix-close-method-call-underlaying-lay
|
||||||
# in upstream after 5.31.8
|
# in upstream after 5.31.8
|
||||||
Patch79: perl-5.31.8-only-install-ExtUtils-XSSymSet-man-page-on-VMS.patch
|
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
|
# 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
|
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
|
%patch77 -p1
|
||||||
%patch78 -p1
|
%patch78 -p1
|
||||||
%patch79 -p1
|
%patch79 -p1
|
||||||
|
%patch80 -p1
|
||||||
|
%patch81 -p1
|
||||||
%patch200 -p1
|
%patch200 -p1
|
||||||
%patch201 -p1
|
%patch201 -p1
|
||||||
|
|
||||||
|
@ -4455,6 +4461,8 @@ perl -x patchlevel.h \
|
||||||
'Fedora Patch77: Fix thread-safety of IO::Handle (GH#14816)' \
|
'Fedora Patch77: Fix thread-safety of IO::Handle (GH#14816)' \
|
||||||
'Fedora Patch78: Close :unix PerlIO layers properly' \
|
'Fedora Patch78: Close :unix PerlIO layers properly' \
|
||||||
'Fedora Patch79: Only install ExtUtils::XSSymSet manual page on VMS (GH#17424)' \
|
'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 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' \
|
'Fedora Patch201: Link XS modules to libperl.so with EU::MM on Linux' \
|
||||||
%{nil}
|
%{nil}
|
||||||
|
@ -7216,6 +7224,7 @@ popd
|
||||||
- Prevent from an integer overflow in POSIX::SigSet()
|
- Prevent from an integer overflow in POSIX::SigSet()
|
||||||
- Fix thread-safety of IO::Handle (GH#14816)
|
- Fix thread-safety of IO::Handle (GH#14816)
|
||||||
- Close :unix PerlIO layers properly
|
- 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
|
* 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>
|
- 5.30.2 bump (see <https://metacpan.org/pod/release/SHAY/perl-5.30.2/pod/perldelta.pod>
|
||||||
|
|
Loading…
Reference in New Issue