Fix handling undefined array members in Dumpvalue
This commit is contained in:
Petr Písař
parent
5d3b4b53fc
commit
cd3b6fccc2
237
perl-5.31.4-Handle-undefined-values-correctly.patch
Normal file
237
perl-5.31.4-Handle-undefined-values-correctly.patch
Normal file
@ -0,0 +1,237 @@
|
||||
From 01aed385e6bdbdcfd13bb66e9d8b7c55d2cfc34a Mon Sep 17 00:00:00 2001
|
||||
From: James E Keenan <jkeenan@cpan.org>
|
||||
Date: Thu, 19 Sep 2019 23:02:54 -0400
|
||||
Subject: [PATCH] Handle undefined values correctly
|
||||
MIME-Version: 1.0
|
||||
Content-Type: text/plain; charset=UTF-8
|
||||
Content-Transfer-Encoding: 8bit
|
||||
|
||||
As reported by Henrik Pauli in RT 134441, the documentation's claim that
|
||||
|
||||
$dv->dumpValue([$x, $y]);
|
||||
|
||||
and
|
||||
|
||||
$dv->dumpValues($x, $y);
|
||||
|
||||
was not being sustained in the case where one of the elements in the
|
||||
array (or array ref) was undefined. This was due to an insufficiently
|
||||
precise specification within the dumpValues() method for determining
|
||||
when the value "undef\n" should be printed.
|
||||
|
||||
Tests for previously untested cases have been provided in
|
||||
t/rt-134441-dumpvalue.t. They were not appended to t/Dumpvalue.t (as
|
||||
would normally have been the case) because the tests in that file have
|
||||
accreted over the years in a sub-optimal manner: changes in attributes
|
||||
of the Dumpvalue object are tested but those changes are not zeroed-out
|
||||
(by, e.g., use of 'local $self->{attribute} = undef')
|
||||
before additional attributes are modified and tested. As a consequence,
|
||||
it's difficult to determine the state of the Dumpvalue object at any
|
||||
particular point and interactions between attributes cannot be ruled
|
||||
out.
|
||||
|
||||
Package TieOut, used to capture STDOUT during testing, has been
|
||||
extracted to its own file so that it can be used by all test files.
|
||||
|
||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||
---
|
||||
MANIFEST | 2 +
|
||||
dist/Dumpvalue/lib/Dumpvalue.pm | 4 +-
|
||||
dist/Dumpvalue/t/Dumpvalue.t | 20 +-----
|
||||
dist/Dumpvalue/t/lib/TieOut.pm | 20 ++++++
|
||||
dist/Dumpvalue/t/rt-134441-dumpvalue.t | 86 ++++++++++++++++++++++++++
|
||||
5 files changed, 112 insertions(+), 20 deletions(-)
|
||||
create mode 100644 dist/Dumpvalue/t/lib/TieOut.pm
|
||||
create mode 100644 dist/Dumpvalue/t/rt-134441-dumpvalue.t
|
||||
|
||||
diff --git a/MANIFEST b/MANIFEST
|
||||
index 7bf62d8479..8159ac8cc1 100644
|
||||
--- a/MANIFEST
|
||||
+++ b/MANIFEST
|
||||
@@ -3455,6 +3455,8 @@ dist/Devel-SelfStubber/lib/Devel/SelfStubber.pm Generate stubs for SelfLoader.pm
|
||||
dist/Devel-SelfStubber/t/Devel-SelfStubber.t See if Devel::SelfStubber works
|
||||
dist/Dumpvalue/lib/Dumpvalue.pm Screen dump of perl values
|
||||
dist/Dumpvalue/t/Dumpvalue.t See if Dumpvalue works
|
||||
+dist/Dumpvalue/t/lib/TieOut.pm Helper module for Dumpvalue tests
|
||||
+dist/Dumpvalue/t/rt-134441-dumpvalue.t See if Dumpvalue works
|
||||
dist/encoding-warnings/lib/encoding/warnings.pm warn on implicit encoding conversions
|
||||
dist/encoding-warnings/t/1-warning.t tests for encoding::warnings
|
||||
dist/encoding-warnings/t/2-fatal.t tests for encoding::warnings
|
||||
diff --git a/dist/Dumpvalue/lib/Dumpvalue.pm b/dist/Dumpvalue/lib/Dumpvalue.pm
|
||||
index eef9b27157..3faf829538 100644
|
||||
--- a/dist/Dumpvalue/lib/Dumpvalue.pm
|
||||
+++ b/dist/Dumpvalue/lib/Dumpvalue.pm
|
||||
@@ -1,7 +1,7 @@
|
||||
use 5.006_001; # for (defined ref) and $#$v and our
|
||||
package Dumpvalue;
|
||||
use strict;
|
||||
-our $VERSION = '1.18';
|
||||
+our $VERSION = '1.19';
|
||||
our(%address, $stab, @stab, %stab, %subs);
|
||||
|
||||
sub ASCII { return ord('A') == 65; }
|
||||
@@ -79,7 +79,7 @@ sub dumpValues {
|
||||
my $self = shift;
|
||||
local %address;
|
||||
local $^W=0;
|
||||
- (print "undef\n"), return unless defined $_[0];
|
||||
+ (print "undef\n"), return if (@_ == 1 and not defined $_[0]);
|
||||
$self->unwrap(\@_,0);
|
||||
}
|
||||
|
||||
diff --git a/dist/Dumpvalue/t/Dumpvalue.t b/dist/Dumpvalue/t/Dumpvalue.t
|
||||
index 7063dd984c..ba8775126e 100644
|
||||
--- a/dist/Dumpvalue/t/Dumpvalue.t
|
||||
+++ b/dist/Dumpvalue/t/Dumpvalue.t
|
||||
@@ -16,6 +16,8 @@ BEGIN {
|
||||
|
||||
our ( $foo, @bar, %baz );
|
||||
|
||||
+use lib ("./t/lib");
|
||||
+use TieOut;
|
||||
use Test::More tests => 88;
|
||||
|
||||
use_ok( 'Dumpvalue' );
|
||||
@@ -278,21 +280,3 @@ is( $out->read, "0 0..0 'two'\n", 'dumpValues worked on array ref' );
|
||||
$d->dumpValues('one', 'two');
|
||||
is( $out->read, "0..1 'one' 'two'\n", 'dumpValues worked on multiple values' );
|
||||
|
||||
-
|
||||
-package TieOut;
|
||||
-use overload '"' => sub { "overloaded!" };
|
||||
-
|
||||
-sub TIEHANDLE {
|
||||
- my $class = shift;
|
||||
- bless(\( my $ref), $class);
|
||||
-}
|
||||
-
|
||||
-sub PRINT {
|
||||
- my $self = shift;
|
||||
- $$self .= join('', @_);
|
||||
-}
|
||||
-
|
||||
-sub read {
|
||||
- my $self = shift;
|
||||
- return substr($$self, 0, length($$self), '');
|
||||
-}
|
||||
diff --git a/dist/Dumpvalue/t/lib/TieOut.pm b/dist/Dumpvalue/t/lib/TieOut.pm
|
||||
new file mode 100644
|
||||
index 0000000000..568caedf9c
|
||||
--- /dev/null
|
||||
+++ b/dist/Dumpvalue/t/lib/TieOut.pm
|
||||
@@ -0,0 +1,20 @@
|
||||
+package TieOut;
|
||||
+use overload '"' => sub { "overloaded!" };
|
||||
+
|
||||
+sub TIEHANDLE {
|
||||
+ my $class = shift;
|
||||
+ bless(\( my $ref), $class);
|
||||
+}
|
||||
+
|
||||
+sub PRINT {
|
||||
+ my $self = shift;
|
||||
+ $$self .= join('', @_);
|
||||
+}
|
||||
+
|
||||
+sub read {
|
||||
+ my $self = shift;
|
||||
+ return substr($$self, 0, length($$self), '');
|
||||
+}
|
||||
+
|
||||
+1;
|
||||
+
|
||||
diff --git a/dist/Dumpvalue/t/rt-134441-dumpvalue.t b/dist/Dumpvalue/t/rt-134441-dumpvalue.t
|
||||
new file mode 100644
|
||||
index 0000000000..cc9f270f5a
|
||||
--- /dev/null
|
||||
+++ b/dist/Dumpvalue/t/rt-134441-dumpvalue.t
|
||||
@@ -0,0 +1,86 @@
|
||||
+BEGIN {
|
||||
+ require Config;
|
||||
+ if (($Config::Config{'extensions'} !~ m!\bList/Util\b!) ){
|
||||
+ print "1..0 # Skip -- Perl configured without List::Util module\n";
|
||||
+ exit 0;
|
||||
+ }
|
||||
+
|
||||
+ # `make test` in the CPAN version of this module runs us with -w, but
|
||||
+ # Dumpvalue.pm relies on all sorts of things that can cause warnings. I
|
||||
+ # don't think that's worth fixing, so we just turn off all warnings
|
||||
+ # during testing.
|
||||
+ $^W = 0;
|
||||
+}
|
||||
+
|
||||
+use lib ("./t/lib");
|
||||
+use TieOut;
|
||||
+use Test::More tests => 17;
|
||||
+
|
||||
+use_ok( 'Dumpvalue' );
|
||||
+
|
||||
+my $d;
|
||||
+ok( $d = Dumpvalue->new(), 'create a new Dumpvalue object' );
|
||||
+
|
||||
+my $out = tie *OUT, 'TieOut';
|
||||
+select(OUT);
|
||||
+
|
||||
+my (@foobar, $x, $y);
|
||||
+
|
||||
+@foobar = ('foo', 'bar');
|
||||
+$d->dumpValue([@foobar]);
|
||||
+$x = $out->read;
|
||||
+is( $x, "0 'foo'\n1 'bar'\n", 'dumpValue worked on array ref' );
|
||||
+$d->dumpValues(@foobar);
|
||||
+$y = $out->read;
|
||||
+is( $y, "0 'foo'\n1 'bar'\n", 'dumpValues worked on array' );
|
||||
+is( $y, $x,
|
||||
+ "dumpValues called on array returns same as dumpValue on array ref");
|
||||
+
|
||||
+@foobar = (undef, 'bar');
|
||||
+$d->dumpValue([@foobar]);
|
||||
+$x = $out->read;
|
||||
+is( $x, "0 undef\n1 'bar'\n",
|
||||
+ 'dumpValue worked on array ref, first element undefined' );
|
||||
+$d->dumpValues(@foobar);
|
||||
+$y = $out->read;
|
||||
+is( $y, "0 undef\n1 'bar'\n",
|
||||
+ 'dumpValues worked on array, first element undefined' );
|
||||
+is( $y, $x,
|
||||
+ "dumpValues called on array returns same as dumpValue on array ref, first element undefined");
|
||||
+
|
||||
+@foobar = ('bar', undef);
|
||||
+$d->dumpValue([@foobar]);
|
||||
+$x = $out->read;
|
||||
+is( $x, "0 'bar'\n1 undef\n",
|
||||
+ 'dumpValue worked on array ref, last element undefined' );
|
||||
+$d->dumpValues(@foobar);
|
||||
+$y = $out->read;
|
||||
+is( $y, "0 'bar'\n1 undef\n",
|
||||
+ 'dumpValues worked on array, last element undefined' );
|
||||
+is( $y, $x,
|
||||
+ "dumpValues called on array returns same as dumpValue on array ref, last element undefined");
|
||||
+
|
||||
+@foobar = ('', 'bar');
|
||||
+$d->dumpValue([@foobar]);
|
||||
+$x = $out->read;
|
||||
+is( $x, "0 ''\n1 'bar'\n",
|
||||
+ 'dumpValue worked on array ref, first element empty string' );
|
||||
+$d->dumpValues(@foobar);
|
||||
+$y = $out->read;
|
||||
+is( $y, "0 ''\n1 'bar'\n",
|
||||
+ 'dumpValues worked on array, first element empty string' );
|
||||
+is( $y, $x,
|
||||
+ "dumpValues called on array returns same as dumpValue on array ref, first element empty string");
|
||||
+
|
||||
+@foobar = ('bar', '');
|
||||
+$d->dumpValue([@foobar]);
|
||||
+$x = $out->read;
|
||||
+is( $x, "0 'bar'\n1 ''\n",
|
||||
+ 'dumpValue worked on array ref, last element empty string' );
|
||||
+$d->dumpValues(@foobar);
|
||||
+$y = $out->read;
|
||||
+is( $y, "0 'bar'\n1 ''\n",
|
||||
+ 'dumpValues worked on array, last element empty string' );
|
||||
+is( $y, $x,
|
||||
+ "dumpValues called on array returns same as dumpValue on array ref, last element empty string");
|
||||
+
|
||||
--
|
||||
2.21.0
|
||||
|
||||
@ -264,6 +264,10 @@ Patch62: perl-5.31.3-Florian-Weimer-is-now-a-perl-author.patch
|
||||
# in upstream after 5.31.3
|
||||
Patch63: perl-5.30.1-perl-125557-correctly-handle-overload-for-bin-oct-fl.patch
|
||||
|
||||
# Fix handling undefined array members in Dumpvalue, RT#134441,
|
||||
# in upstream after 5.31.4
|
||||
Patch64: perl-5.31.4-Handle-undefined-values-correctly.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
|
||||
|
||||
@ -2848,6 +2852,7 @@ rm -rf .git # Perl tests examine a git repository
|
||||
%patch61 -p1
|
||||
%patch62 -p1
|
||||
%patch63 -p1
|
||||
%patch64 -p1
|
||||
%patch200 -p1
|
||||
%patch201 -p1
|
||||
|
||||
@ -2906,6 +2911,7 @@ perl -x patchlevel.h \
|
||||
'Fedora Patch61: Fix a detection for futimes (RT#134432)' \
|
||||
'Fedora Patch62: Fix a detection for futimes (RT#134432)' \
|
||||
'Fedora Patch63: Fix overloading for binary and octal floats (RT#125557)' \
|
||||
'Fedora Patch64: Fix handling undefined array members in Dumpvalue (RT#134441)' \
|
||||
'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}
|
||||
@ -5153,6 +5159,7 @@ popd
|
||||
%changelog
|
||||
* Tue Nov 12 2019 Petr Pisar <ppisar@redhat.com> - 4:5.30.1-448
|
||||
- Fix overloading for binary and octal floats (RT#125557)
|
||||
- Fix handling undefined array members in Dumpvalue (RT#134441)
|
||||
|
||||
* Mon Nov 11 2019 Jitka Plesnikova <jplesnik@redhat.com> - 4:5.30.1-447
|
||||
- 5.30.1 bump (see <https://metacpan.org/pod/release/SHAY/perl-5.30.1/pod/perldelta.pod>
|
||||
|
||||
Loading…
Reference in New Issue
Block a user