Dumpvalue's dumpValue and dumpValues do not behave the same way #17155
Comments
From henrik.pauli@comnica.comThis is a bug report for perl from henrik.pauli@comnica.com, Contrary to what the manual claims, the singular and the plural form ```perl my $dv = Dumpvalue->new(); say "x = " . ($x // "<UNDEF>"); Output: Expected output: Both should say Flags: This perlbug was built using Perl 5.28.2 - Thu Aug 22 12:32:10 UTC 2019 Site configuration information for perl 5.28.2: Configured by Red Hat, Inc. at Thu Aug 22 12:27:54 UTC 2019. Summary of my perl5 (revision 5 version 28 subversion 2) configuration: Platform: Locally applied patches: @INC for perl 5.28.2: Environment for perl 5.28.2: |
From @jkeenanOn Thu, 19 Sep 2019 13:06:49 GMT, henrik.pauli@comnica.com wrote:
I believe that the patch attached confirms the bug. It appears that the methods cannot properly handle undefined values in the array passed to the dumpValues() method or to the arrayref passed to the dumpValue() method. These cases were not previously tested. Thank you very much. -- |
From @jkeenan0001-Test-previously-untested-cases.patchFrom 1bd3f4b050f460a6bf5c2ada695abc5a5a92e21b 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] Test previously untested cases
These tests demonstrate the problem reported in RT 134441. It appears
that neither '$d->dumpValues(@array)' nor '$d->dumpValue([@array])'
properly handles undefined values, at least where @array > 1.
---
dist/Dumpvalue/t/Dumpvalue.t | 45 +++++++++++++++++++++++++++++++++++-
1 file changed, 44 insertions(+), 1 deletion(-)
diff --git a/dist/Dumpvalue/t/Dumpvalue.t b/dist/Dumpvalue/t/Dumpvalue.t
index 7063dd984c..f04b854014 100644
--- a/dist/Dumpvalue/t/Dumpvalue.t
+++ b/dist/Dumpvalue/t/Dumpvalue.t
@@ -16,7 +16,7 @@ BEGIN {
our ( $foo, @bar, %baz );
-use Test::More tests => 88;
+use Test::More qw(no_plan); # tests => 88;
use_ok( 'Dumpvalue' );
@@ -270,6 +270,49 @@ is( $out->read, "'two'\n", 'dumpValue worked on array' );
$d->dumpValue(\$foo);
is( $out->read, "-> 'one'\n", 'dumpValue worked on scalar ref' );
+# RT 134441
+@foobar = ('foo', 'bar');
+$d->dumpValue([@foobar]);
+$x = $out->read;
+is( $x, "0..1 'foo' 'bar'\n", 'dumpValue worked on array ref' );
+$d->dumpValues(@foobar);
+$y = $out->read;
+is( $y, "0..1 'foo' '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]);
+is( $out->read, "0..1 undef 'bar'\n",
+ 'dumpValue worked on array ref, first element undefined' );
+$d->dumpValues(@foobar);
+is( $out->read, "0..1 undef 'bar'\n",
+ 'dumpValues worked on array, first element undefined' );
+
+@foobar = ('bar', undef);
+$d->dumpValue([@foobar]);
+is( $out->read, "0..1 'bar' undef\n",
+ 'dumpValue worked on array ref, last element undefined' );
+$d->dumpValues(@foobar);
+is( $out->read, "0..1 'bar' undef'bar'\n",
+ 'dumpValues worked on array, last element undefined' );
+
+@foobar = ('', 'bar');
+$d->dumpValue([@foobar]);
+is( $out->read, "0..1 '' 'bar'\n",
+ 'dumpValue worked on array ref, first element empty string' );
+$d->dumpValues(@foobar);
+is( $out->read, "0..1 '' 'bar'\n",
+ 'dumpValues worked on array, first element empty string' );
+
+@foobar = ('bar', '');
+$d->dumpValue([@foobar]);
+is( $out->read, "0..1 'bar' ''\n",
+ 'dumpValue worked on array ref, last element empty string' );
+$d->dumpValues(@foobar);
+is( $out->read, "0..1 'bar' ''\n",
+ 'dumpValues worked on array, last element empty string' );
+
# dumpValues (the rest of these should be caught by unwrap)
$d->dumpValues(undef);
is( $out->read, "undef\n", 'dumpValues caught undef value fine' );
--
2.17.1
|
|
The RT System itself - Status changed from 'new' to 'open' |
From @jkeenanOn Fri, 20 Sep 2019 03:09:32 GMT, jkeenan wrote:
What the patch produces for test output (attached). -- |
From @jkeenan[perl] 572 $ cd t;./perl harness -v ../dist/Dumpvalue/t/Dumpvalue.t; cd - # Failed test 'dumpValue worked on array ref, first element undefined' # Failed test 'dumpValues worked on array, first element undefined' # Failed test 'dumpValue worked on array ref, last element undefined' # Failed test 'dumpValues worked on array, last element undefined' Test Summary Report ../dist/Dumpvalue/t/Dumpvalue.t (Wstat: 1024 Tests: 99 Failed: 4) |
From @jkeenanOn Sun, 06 Oct 2019 02:28:46 GMT, jkeenan wrote:
Please review patch attached. I believe I have fixed the bug which generated the original report. This patch is smoking in this branch: smoke-me/jkeenan/134441-Dumpvalue Thank you very much. -- |
From @jkeenan134441-0001-Handle-undefined-values-correctly.patchFrom db372bbb70bf14081d7d17c033c8f9af7c86ebfb 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
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.
---
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.17.1
|
From @jkeenanOn Mon, 07 Oct 2019 01:19:50 GMT, jkeenan wrote:
Having heard no objection, I merged this branch to blead in commit 01aed38. I've discovered other problems with Dumpvalue which I'll be reporting in new tickets or on the list. We'll proceed from the commit above. Thank you very much. -- |
|
@jkeenan - Status changed from 'open' to 'resolved' |
|
@jkeenan - Status changed from 'resolved' to 'pending release' |
Migrated from rt.perl.org#134441 (status was 'pending release')
Searchable as RT134441$
The text was updated successfully, but these errors were encountered: