rpms
/
perl-Data-Dumper
2
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Upgrade to 2.170 as provided in perl-5.28.0-RC1

This commit is contained in:
Jitka Plesnikova 2018-05-23 17:47:11 +02:00
parent 8e85cc7e61
commit 19782bfcf4
5 changed files with 642 additions and 292 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
Data-Dumper-2.167-Provide-SvPVCLEAR-macro.patch
View File

@ -1,34 +0,0 @@
From c38b7faa8bb565553bf125da7244f013822735ff Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Thu, 11 May 2017 13:44:14 +0200
Subject: [PATCH] Provide SvPVCLEAR() macro
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
To build with perl <= 5.25.5.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Dumper.xs | 5 +++++
1 file changed, 5 insertions(+)
diff --git a/Dumper.xs b/Dumper.xs
index 0e7142e..5a21721 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -8,6 +8,11 @@
# include "ppport.h"
#endif
+/* SvPVCLEAR was added after 5.25.5 and ppport.h does not provide it */
+#if !defined SvPVCLEAR
+#define SvPVCLEAR(x) sv_setpvs((x), "")
+#endif
+
#if PERL_VERSION < 8
# define DD_USE_OLD_ID_FORMAT
#endif
--
2.9.3

635
Data-Dumper-2.167-Upgrade-to-2.170.patch Normal file
View File

@ -0,0 +1,635 @@
From 89ac68b90b8b1f62170c63cf90390fc2482e1b68 Mon Sep 17 00:00:00 2001
From: Jitka Plesnikova <jplesnik@redhat.com>
Date: Wed, 23 May 2018 17:37:07 +0200
Subject: [PATCH] Upgrade to 2.170
---
Changes | 16 ++++++++++-
Dumper.pm | 61 +++++++++++++++++++++++------------------
Dumper.xs | 56 +++++++++++++++++++++++---------------
t/dumper.t | 65 +++++++++++++++++++++++++++++++++++++++++++-
t/indent.t | 8 +-----
t/misc.t | 16 +----------
t/pair.t | 2 +-
t/purity_deepcopy_maxdepth.t | 17 +-----------
t/quotekeys.t | 5 ++--
t/terse.t | 33 +++++++---------------
10 files changed, 164 insertions(+), 115 deletions(-)
diff --git a/Changes b/Changes
index a5430d5..95e3a8a 100644
--- a/Changes
+++ b/Changes
@@ -6,7 +6,21 @@ Changes - public release history for Data::Dumper
=over 8
-=item 2,166 (Nov 29 2016)
+=item 2.167_02 (Aug 4 2017)
+
+Attempt to work around XS deparse issues on old perls.
+According to the few old perls at my disposure, this now repairs,
+for example 5.18, but 5.8.9 still barfs. My debugging hasn't
+really come up with much since all changes other than the deparse
+change look benign to me.
+Can someone who uses ancient perls please step up and take a look?
+--Steffen
+
+=item 2.167_01 (Jul 31 2017)
+
+CPAN dev release with the accumulated changes from core perl.
+
+=item 2.166 (Nov 29 2016)
Reduce memory usage by not importing from Carp
Reduce memory usage by removing unused overload require.
diff --git a/Dumper.pm b/Dumper.pm
index 00f6326..00c99ec 100644
--- a/Dumper.pm
+++ b/Dumper.pm
@@ -10,7 +10,7 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.167'; # Don't forget to set version and release
+ $VERSION = '2.170'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
@@ -18,6 +18,8 @@ BEGIN {
use 5.006_001;
require Exporter;
+use constant IS_PRE_520_PERL => $] < 5.020;
+
use Carp ();
BEGIN {
@@ -224,12 +226,19 @@ sub Names {
sub DESTROY {}
sub Dump {
- return &Dumpxs
- unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl})
+ # On old versions of perl, the xs-deparse support can fail
+ # mysteriously. Barring copious spare time, it's best to revert
+ # to the previously standard behavior of using the pure perl dumper
+ # for deparsing on old perls. --Steffen
+ if (IS_PRE_520_PERL and ($Data::Dumper::Deparse or (ref($_[0]) && $_[0]->{deparse}))) {
+ return &Dumpperl;
+ }
+ return &Dumpxs
+ unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl})
# Use pure perl version on earlier releases on EBCDIC platforms
|| (! $IS_ASCII && $] lt 5.021_010);
- return &Dumpperl;
+ return &Dumpperl;
}
#
@@ -527,8 +536,8 @@ sub _dump {
$ref = \$val;
if (ref($ref) eq 'GLOB') { # glob
my $name = substr($val, 1);
- if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
- $name =~ s/^main::/::/;
+ $name =~ s/^main::(?!\z)/::/;
+ if ($name =~ /\A(?:[A-Z_a-z][0-9A-Z_a-z]*)?::(?:[0-9A-Z_a-z]+::)*[0-9A-Z_a-z]*\z/ && $name ne 'main::') {
$sname = $name;
}
else {
@@ -618,7 +627,7 @@ sub Reset {
sub Indent {
my($s, $v) = @_;
- if (defined($v)) {
+ if (@_ >= 2) {
if ($v == 0) {
$s->{xpad} = "";
$s->{sep} = "";
@@ -637,92 +646,92 @@ sub Indent {
sub Trailingcomma {
my($s, $v) = @_;
- defined($v) ? (($s->{trailingcomma} = $v), return $s) : $s->{trailingcomma};
+ @_ >= 2 ? (($s->{trailingcomma} = $v), return $s) : $s->{trailingcomma};
}
sub Pair {
my($s, $v) = @_;
- defined($v) ? (($s->{pair} = $v), return $s) : $s->{pair};
+ @_ >= 2 ? (($s->{pair} = $v), return $s) : $s->{pair};
}
sub Pad {
my($s, $v) = @_;
- defined($v) ? (($s->{pad} = $v), return $s) : $s->{pad};
+ @_ >= 2 ? (($s->{pad} = $v), return $s) : $s->{pad};
}
sub Varname {
my($s, $v) = @_;
- defined($v) ? (($s->{varname} = $v), return $s) : $s->{varname};
+ @_ >= 2 ? (($s->{varname} = $v), return $s) : $s->{varname};
}
sub Purity {
my($s, $v) = @_;
- defined($v) ? (($s->{purity} = $v), return $s) : $s->{purity};
+ @_ >= 2 ? (($s->{purity} = $v), return $s) : $s->{purity};
}
sub Useqq {
my($s, $v) = @_;
- defined($v) ? (($s->{useqq} = $v), return $s) : $s->{useqq};
+ @_ >= 2 ? (($s->{useqq} = $v), return $s) : $s->{useqq};
}
sub Terse {
my($s, $v) = @_;
- defined($v) ? (($s->{terse} = $v), return $s) : $s->{terse};
+ @_ >= 2 ? (($s->{terse} = $v), return $s) : $s->{terse};
}
sub Freezer {
my($s, $v) = @_;
- defined($v) ? (($s->{freezer} = $v), return $s) : $s->{freezer};
+ @_ >= 2 ? (($s->{freezer} = $v), return $s) : $s->{freezer};
}
sub Toaster {
my($s, $v) = @_;
- defined($v) ? (($s->{toaster} = $v), return $s) : $s->{toaster};
+ @_ >= 2 ? (($s->{toaster} = $v), return $s) : $s->{toaster};
}
sub Deepcopy {
my($s, $v) = @_;
- defined($v) ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
+ @_ >= 2 ? (($s->{deepcopy} = $v), return $s) : $s->{deepcopy};
}
sub Quotekeys {
my($s, $v) = @_;
- defined($v) ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
+ @_ >= 2 ? (($s->{quotekeys} = $v), return $s) : $s->{quotekeys};
}
sub Bless {
my($s, $v) = @_;
- defined($v) ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
+ @_ >= 2 ? (($s->{'bless'} = $v), return $s) : $s->{'bless'};
}
sub Maxdepth {
my($s, $v) = @_;
- defined($v) ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
+ @_ >= 2 ? (($s->{'maxdepth'} = $v), return $s) : $s->{'maxdepth'};
}
sub Maxrecurse {
my($s, $v) = @_;
- defined($v) ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'};
+ @_ >= 2 ? (($s->{'maxrecurse'} = $v), return $s) : $s->{'maxrecurse'};
}
sub Useperl {
my($s, $v) = @_;
- defined($v) ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
+ @_ >= 2 ? (($s->{'useperl'} = $v), return $s) : $s->{'useperl'};
}
sub Sortkeys {
my($s, $v) = @_;
- defined($v) ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
+ @_ >= 2 ? (($s->{'sortkeys'} = $v), return $s) : $s->{'sortkeys'};
}
sub Deparse {
my($s, $v) = @_;
- defined($v) ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
+ @_ >= 2 ? (($s->{'deparse'} = $v), return $s) : $s->{'deparse'};
}
sub Sparseseen {
my($s, $v) = @_;
- defined($v) ? (($s->{'noseen'} = $v), return $s) : $s->{'noseen'};
+ @_ >= 2 ? (($s->{'noseen'} = $v), return $s) : $s->{'noseen'};
}
# used by qquote below
@@ -1465,7 +1474,7 @@ modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.167 (January 4 2017)
+Version 2.170
=head1 SEE ALSO
diff --git a/Dumper.xs b/Dumper.xs
index 0e7142e..174562c 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -12,6 +12,14 @@
# define DD_USE_OLD_ID_FORMAT
#endif
+#ifndef strlcpy
+# ifdef my_strlcpy
+# define strlcpy(d,s,l) my_strlcpy(d,s,l)
+# else
+# define strlcpy(d,s,l) strcpy(d,s)
+# endif
+#endif
+
/* These definitions are ASCII only. But the pure-perl .pm avoids
* calling this .xs file for releases where they aren't defined */
@@ -41,6 +49,17 @@
|| (((UV) (c)) >= '0' && ((UV) (c)) <= '9'))
#endif
+/* SvPVCLEAR only from perl 5.25.6 */
+#ifndef SvPVCLEAR
+# define SvPVCLEAR(sv) sv_setpvs((sv), "")
+#endif
+
+#ifndef memBEGINs
+# define memBEGINs(s1, l, s2) \
+ ( (l) >= sizeof(s2) - 1 \
+ && memEQ(s1, "" s2 "", sizeof(s2)-1))
+#endif
+
/* This struct contains almost all the user's desired configuration, and it
* is treated as constant by the recursive function. This arrangement has
* the advantage of needing less memory than passing all of them on the
@@ -851,7 +870,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
SV * const ixsv = newSViv(0);
/* allowing for a 24 char wide array index */
New(0, iname, namelen+28, char);
- (void)strcpy(iname, name);
+ (void) strlcpy(iname, name, namelen+28);
inamelen = namelen;
if (name[0] == '@') {
sv_catpvs(retval, "(");
@@ -1285,7 +1304,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
else if (realtype == SVt_PVGV) {/* GLOBs can end up with scribbly names */
c = SvPV(val, i);
if(i) ++c, --i; /* just get the name */
- if (i >= 6 && strncmp(c, "main::", 6) == 0) {
+ if (memBEGINs(c, i, "main::")) {
c += 4;
#if PERL_VERSION < 7
if (i == 6 || (i == 7 && c[6] == '\0'))
@@ -1295,37 +1314,30 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
i = 0; else i -= 4;
}
if (globname_needs_quote(c,i)) {
-#ifdef GvNAMEUTF8
- if (GvNAMEUTF8(val)) {
- sv_grow(retval, SvCUR(retval)+2);
+ sv_grow(retval, SvCUR(retval)+3);
r = SvPVX(retval)+SvCUR(retval);
- r[0] = '*'; r[1] = '{';
+ r[0] = '*'; r[1] = '{'; r[2] = 0;
SvCUR_set(retval, SvCUR(retval)+2);
- esc_q_utf8(aTHX_ retval, c, i, 1, style->useqq);
+ i = 3 + esc_q_utf8(aTHX_ retval, c, i,
+#ifdef GvNAMEUTF8
+ !!GvNAMEUTF8(val)
+#else
+ 0
+#endif
+ , style->useqq);
sv_grow(retval, SvCUR(retval)+2);
r = SvPVX(retval)+SvCUR(retval);
r[0] = '}'; r[1] = '\0';
- i = 1;
- }
- else
-#endif
- {
- sv_grow(retval, SvCUR(retval)+6+2*i);
- r = SvPVX(retval)+SvCUR(retval);
- r[0] = '*'; r[1] = '{'; r[2] = '\'';
- i += esc_q(r+3, c, i);
- i += 3;
- r[i++] = '\''; r[i++] = '}';
- r[i] = '\0';
- }
+ SvCUR_set(retval, SvCUR(retval)+1);
+ r = r+1 - i;
}
else {
sv_grow(retval, SvCUR(retval)+i+2);
r = SvPVX(retval)+SvCUR(retval);
- r[0] = '*'; strcpy(r+1, c);
+ r[0] = '*'; strlcpy(r+1, c, SvLEN(retval));
i++;
+ SvCUR_set(retval, SvCUR(retval)+i);
}
- SvCUR_set(retval, SvCUR(retval)+i);
if (style->purity) {
static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
diff --git a/t/dumper.t b/t/dumper.t
index 643160a..e09a2dd 100644
--- a/t/dumper.t
+++ b/t/dumper.t
@@ -108,7 +108,7 @@ sub SKIP_TEST {
++$TNUM; print "ok $TNUM # skip $reason\n";
}
-$TMAX = 450;
+$TMAX = 468;
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
# it direct. Out here it lets us knobble the next if to test that the perl
@@ -1740,3 +1740,66 @@ EOT
TEST (qq(Dumper("\n")), '\n alone');
TEST (qq(Data::Dumper::DumperX("\n")), '\n alone') if $XS;
}
+#############
+our @globs = map { $_, \$_ } map { *$_ } map { $_, "s::$_" }
+ "foo", "\1bar", "L\x{e9}on", "m\x{100}cron", "snow\x{2603}";
+$WANT = <<'EOT';
+#$globs = [
+# *::foo,
+# \*::foo,
+# *s::foo,
+# \*s::foo,
+# *{"::\1bar"},
+# \*{"::\1bar"},
+# *{"s::\1bar"},
+# \*{"s::\1bar"},
+# *{"::L\351on"},
+# \*{"::L\351on"},
+# *{"s::L\351on"},
+# \*{"s::L\351on"},
+# *{"::m\x{100}cron"},
+# \*{"::m\x{100}cron"},
+# *{"s::m\x{100}cron"},
+# \*{"s::m\x{100}cron"},
+# *{"::snow\x{2603}"},
+# \*{"::snow\x{2603}"},
+# *{"s::snow\x{2603}"},
+# \*{"s::snow\x{2603}"}
+#];
+EOT
+{
+ local $Data::Dumper::Useqq = 1;
+ TEST (q(Data::Dumper->Dump([\@globs], ["globs"])), 'globs: Dump()');
+ TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
+ if $XS;
+}
+#############
+$WANT = <<'EOT';
+#$v = {
+# a => \*::ppp,
+# b => \*{'::a/b'},
+# c => \*{"::a\x{2603}b"}
+#};
+#*::ppp = {
+# a => 1
+#};
+#*{'::a/b'} = {
+# b => 3
+#};
+#*{"::a\x{2603}b"} = {
+# c => 5
+#};
+EOT
+{
+ *ppp = { a => 1 };
+ *{"a/b"} = { b => 3 };
+ *{"a\x{2603}b"} = { c => 5 };
+ our $v = { a => \*ppp, b => \*{"a/b"}, c => \*{"a\x{2603}b"} };
+ local $Data::Dumper::Purity = 1;
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
+ $WANT =~ tr/'/"/;
+ local $Data::Dumper::Useqq = 1;
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
+}
diff --git a/t/indent.t b/t/indent.t
index bcfa251..2814f0b 100644
--- a/t/indent.t
+++ b/t/indent.t
@@ -14,7 +14,7 @@ BEGIN {
use strict;
use Data::Dumper;
-use Test::More tests => 10;
+use Test::More tests => 9;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );
@@ -34,10 +34,6 @@ $dumper = Data::Dumper->new([$hash]);
$dumper->Indent();
$dumpstr{indent_no_arg} = _dumptostr($dumper);
-$dumper = Data::Dumper->new([$hash]);
-$dumper->Indent(undef);
-$dumpstr{indent_undef} = _dumptostr($dumper);
-
$dumper = Data::Dumper->new([$hash]);
$dumper->Indent(0);
$dumpstr{indent_0} = _dumptostr($dumper);
@@ -59,8 +55,6 @@ $dumpstr{indent_2} = _dumptostr($dumper);
is($dumpstr{noindent}, $dumpstr{indent_no_arg},
"absence of Indent is same as Indent()");
-is($dumpstr{noindent}, $dumpstr{indent_undef},
- "absence of Indent is same as Indent(undef)");
isnt($dumpstr{noindent}, $dumpstr{indent_0},
"absence of Indent is different from Indent(0)");
isnt($dumpstr{indent_0}, $dumpstr{indent_1},
diff --git a/t/misc.t b/t/misc.t
index 2ce81ac..54a89e6 100644
--- a/t/misc.t
+++ b/t/misc.t
@@ -15,7 +15,7 @@ BEGIN {
use strict;
use Data::Dumper;
-use Test::More tests => 20;
+use Test::More tests => 18;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );
@@ -76,17 +76,10 @@ note("Argument validation for new()");
$obj = Data::Dumper->new([$a,$b]);
$dumps{'noprev'} = _dumptostr($obj);
- $obj = Data::Dumper->new([$a,$b]);
- $obj->Pad(undef);
- $dumps{'undef'} = _dumptostr($obj);
-
$obj = Data::Dumper->new([$a,$b]);
$obj->Pad('');
$dumps{'emptystring'} = _dumptostr($obj);
- is($dumps{'noprev'}, $dumps{'undef'},
- "No setting for \$Data::Dumper::Pad and Pad(undef) give same result");
-
is($dumps{'noprev'}, $dumps{'emptystring'},
"No setting for \$Data::Dumper::Pad and Pad('') give same result");
@@ -113,17 +106,10 @@ note("Argument validation for new()");
$obj = Data::Dumper->new([$a,$b]);
$dumps{'noprev'} = _dumptostr($obj);
- $obj = Data::Dumper->new([$a,$b]);
- $obj->Varname(undef);
- $dumps{'undef'} = _dumptostr($obj);
-
$obj = Data::Dumper->new([$a,$b]);
$obj->Varname('');
$dumps{'emptystring'} = _dumptostr($obj);
- is($dumps{'noprev'}, $dumps{'undef'},
- "No setting for \$Data::Dumper::Varname and Varname(undef) give same result");
-
# Because Varname defaults to '$VAR', providing an empty argument to
# Varname produces a non-default result.
isnt($dumps{'noprev'}, $dumps{'emptystring'},
diff --git a/t/pair.t b/t/pair.t
index 9559bdd..c7eafe4 100644
--- a/t/pair.t
+++ b/t/pair.t
@@ -15,7 +15,7 @@ BEGIN {
}
use strict;
-use vars qw($want_colon $want_comma);
+our ($want_colon, $want_comma);
use Test::More tests => 9;
no warnings qw(once);
diff --git a/t/purity_deepcopy_maxdepth.t b/t/purity_deepcopy_maxdepth.t
index f287101..3a7dc49 100644
--- a/t/purity_deepcopy_maxdepth.t
+++ b/t/purity_deepcopy_maxdepth.t
@@ -16,7 +16,7 @@ BEGIN {
use strict;
use Data::Dumper;
-use Test::More tests => 24;
+use Test::More tests => 22;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );
@@ -80,14 +80,6 @@ note("\$Data::Dumper::Purity and Purity()");
is($dumps{'noprev'}, $dumps{'objzero'},
"No previous Purity setting equivalent to Purity(0)");
-
- $purity = undef;
- $obj = Data::Dumper->new([$a,$b,$c], [qw(a b c)]);
- $obj->Purity($purity);
- $dumps{'objundef'} = _dumptostr($obj);
-
- is($dumps{'noprev'}, $dumps{'objundef'},
- "No previous Purity setting equivalent to Purity(undef)");
}
{
@@ -364,13 +356,6 @@ note("\$Data::Dumper::Maxdepth and Maxdepth()");
is($dumps{'noprev'}, $dumps{'maxdepthempty'},
"No previous Maxdepth setting equivalent to Maxdepth() with no argument");
- $obj = Data::Dumper->new([$f], [qw(f)]);
- $obj->Maxdepth(undef);
- $dumps{'maxdepthundef'} = _dumptostr($obj);
-
- is($dumps{'noprev'}, $dumps{'maxdepthundef'},
- "No previous Maxdepth setting equivalent to Maxdepth(undef)");
-
$maxdepth = 3;
$obj = Data::Dumper->new([$f], [qw(f)]);
$obj->Maxdepth($maxdepth);
diff --git a/t/quotekeys.t b/t/quotekeys.t
index 0f6313a..076cdf6 100644
--- a/t/quotekeys.t
+++ b/t/quotekeys.t
@@ -86,10 +86,9 @@ sub run_tests_for_quotekeys {
$obj->Quotekeys($quotekeys);
$dumps{'objqkundef'} = _dumptostr($obj);
- note("Quotekeys(undef) will fall back to the default value\nfor \$Data::Dumper::Quotekeys, which is a true value.");
- isnt($dumps{'ddqkundef'}, $dumps{'objqkundef'},
+ is($dumps{'ddqkundef'}, $dumps{'objqkundef'},
"\$Data::Dumper::Quotekeys = undef and Quotekeys(undef) are equivalent");
- isnt($dumps{'ddqkzero'}, $dumps{'objqkundef'},
+ is($dumps{'ddqkzero'}, $dumps{'objqkundef'},
"\$Data::Dumper::Quotekeys = undef and = 0 are equivalent");
%dumps = ();
diff --git a/t/terse.t b/t/terse.t
index a5be980..a815c36 100644
--- a/t/terse.t
+++ b/t/terse.t
@@ -3,7 +3,7 @@ use strict;
use warnings;
use Data::Dumper;
-use Test::More tests => 6;
+use Test::More tests => 10;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );
@@ -23,39 +23,26 @@ for my $useperl (0..1) {
WANT
}
-my (%dumpstr);
my $dumper;
$dumper = Data::Dumper->new([$hash]);
-$dumpstr{noterse} = _dumptostr($dumper);
-# $VAR1 = {
-# 'foo' => 42
-# };
+my $dumpstr_noterse = _dumptostr($dumper);
$dumper = Data::Dumper->new([$hash]);
$dumper->Terse();
-$dumpstr{terse_no_arg} = _dumptostr($dumper);
+is _dumptostr($dumper), $dumpstr_noterse;
$dumper = Data::Dumper->new([$hash]);
$dumper->Terse(0);
-$dumpstr{terse_0} = _dumptostr($dumper);
+is _dumptostr($dumper), $dumpstr_noterse;
$dumper = Data::Dumper->new([$hash]);
$dumper->Terse(1);
-$dumpstr{terse_1} = _dumptostr($dumper);
-# {
-# 'foo' => 42
-# }
+isnt _dumptostr($dumper), $dumpstr_noterse;
$dumper = Data::Dumper->new([$hash]);
-$dumper->Terse(undef);
-$dumpstr{terse_undef} = _dumptostr($dumper);
-
-is($dumpstr{noterse}, $dumpstr{terse_no_arg},
- "absence of Terse is same as Terse()");
-is($dumpstr{noterse}, $dumpstr{terse_0},
- "absence of Terse is same as Terse(0)");
-isnt($dumpstr{noterse}, $dumpstr{terse_1},
- "absence of Terse is different from Terse(1)");
-is($dumpstr{noterse}, $dumpstr{terse_undef},
- "absence of Terse is same as Terse(undef)");
+is $dumper->Terse(1), $dumper;
+is $dumper->Terse, 1;
+is $dumper->Terse(undef), $dumper;
+is $dumper->Terse, undef;
+is _dumptostr($dumper), $dumpstr_noterse;
--
2.14.3

112
Data-Dumper-2.167-fix-Data-Dumper-postentry-for-quoted-glob.patch
View File

@ -1,112 +0,0 @@
From 76b7c82c2947d64a3494175ef6530b3fba8a499d Mon Sep 17 00:00:00 2001
From: Zefram <zefram@fysh.org>
Date: Wed, 10 Jan 2018 21:09:45 +0000
Subject: [PATCH] fix Data-Dumper postentry for quoted glob
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
In Data-Dumper, where a glob with a quoted name required a postentry,
the name part of the postentry was being emitted as just "}". This was
an old bug affecting upgraded glob names, which the recent commit
abda9fe0fe75ae824723761c1c98af958f17a41c made affect all quoted glob
names. Fix the postentry name to encompass the entire quoted name.
Fixes [perl #132695].
Petr Písař: Ported to Data-Dumpe-2.167 from perl
fb5043174b070927d312677f0a2f04a29b11349a.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Dumper.xs | 11 ++++++-----
t/dumper.t | 32 +++++++++++++++++++++++++++++++-
2 files changed, 37 insertions(+), 6 deletions(-)
diff --git a/Dumper.xs b/Dumper.xs
index 8a16e04..206e8b5 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -1300,11 +1300,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
i = 0; else i -= 4;
}
if (globname_needs_quote(c,i)) {
- sv_grow(retval, SvCUR(retval)+2);
+ sv_grow(retval, SvCUR(retval)+3);
r = SvPVX(retval)+SvCUR(retval);
- r[0] = '*'; r[1] = '{';
+ r[0] = '*'; r[1] = '{'; r[2] = 0;
SvCUR_set(retval, SvCUR(retval)+2);
- esc_q_utf8(aTHX_ retval, c, i,
+ i = 3 + esc_q_utf8(aTHX_ retval, c, i,
#ifdef GvNAMEUTF8
!!GvNAMEUTF8(val)
#else
@@ -1314,15 +1314,16 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_grow(retval, SvCUR(retval)+2);
r = SvPVX(retval)+SvCUR(retval);
r[0] = '}'; r[1] = '\0';
- i = 1;
+ SvCUR_set(retval, SvCUR(retval)+1);
+ r = r+1 - i;
}
else {
sv_grow(retval, SvCUR(retval)+i+2);
r = SvPVX(retval)+SvCUR(retval);
r[0] = '*'; strcpy(r+1, c);
i++;
+ SvCUR_set(retval, SvCUR(retval)+i);
}
- SvCUR_set(retval, SvCUR(retval)+i);
if (style->purity) {
static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
diff --git a/t/dumper.t b/t/dumper.t
index 0c12f34..e09a2dd 100644
--- a/t/dumper.t
+++ b/t/dumper.t
@@ -108,7 +108,7 @@ sub SKIP_TEST {
++$TNUM; print "ok $TNUM # skip $reason\n";
}
-$TMAX = 456;
+$TMAX = 468;
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
# it direct. Out here it lets us knobble the next if to test that the perl
@@ -1773,3 +1773,33 @@ EOT
TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
if $XS;
}
+#############
+$WANT = <<'EOT';
+#$v = {
+# a => \*::ppp,
+# b => \*{'::a/b'},
+# c => \*{"::a\x{2603}b"}
+#};
+#*::ppp = {
+# a => 1
+#};
+#*{'::a/b'} = {
+# b => 3
+#};
+#*{"::a\x{2603}b"} = {
+# c => 5
+#};
+EOT
+{
+ *ppp = { a => 1 };
+ *{"a/b"} = { b => 3 };
+ *{"a\x{2603}b"} = { c => 5 };
+ our $v = { a => \*ppp, b => \*{"a/b"}, c => \*{"a\x{2603}b"} };
+ local $Data::Dumper::Purity = 1;
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
+ $WANT =~ tr/'/"/;
+ local $Data::Dumper::Useqq = 1;
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
+}
--
2.13.6

134
Data-Dumper-2.167-in-Data-Dumper-quote-glob-names-better.patch
View File

@ -1,134 +0,0 @@
From 69beb4272d324bb0724b140b5ddca517e90d89b9 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
Date: Tue, 5 Dec 2017 10:59:42 +0100
Subject: [PATCH] in Data-Dumper, quote glob names better
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Ported to Data-Dumper-1.167 from perl git tree:
commit abda9fe0fe75ae824723761c1c98af958f17a41c
Author: Zefram <zefram@fysh.org>
Date: Fri Dec 1 17:35:35 2017 +0000
in Data-Dumper, quote glob names better
Glob name quoting should obey Useqq. Fixes [perl #119831].
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Dumper.pm | 4 ++--
Dumper.xs | 22 +++++++---------------
t/dumper.t | 35 ++++++++++++++++++++++++++++++++++-
3 files changed, 43 insertions(+), 18 deletions(-)
diff --git a/Dumper.pm b/Dumper.pm
index 00f6326..696964a 100644
--- a/Dumper.pm
+++ b/Dumper.pm
@@ -527,8 +527,8 @@ sub _dump {
$ref = \$val;
if (ref($ref) eq 'GLOB') { # glob
my $name = substr($val, 1);
- if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
- $name =~ s/^main::/::/;
+ $name =~ s/^main::(?!\z)/::/;
+ if ($name =~ /\A(?:[A-Z_a-z][0-9A-Z_a-z]*)?::(?:[0-9A-Z_a-z]+::)*[0-9A-Z_a-z]*\z/ && $name ne 'main::') {
$sname = $name;
}
else {
diff --git a/Dumper.xs b/Dumper.xs
index 5a21721..8a16e04 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -1300,29 +1300,21 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
i = 0; else i -= 4;
}
if (globname_needs_quote(c,i)) {
-#ifdef GvNAMEUTF8
- if (GvNAMEUTF8(val)) {
sv_grow(retval, SvCUR(retval)+2);
r = SvPVX(retval)+SvCUR(retval);
r[0] = '*'; r[1] = '{';
SvCUR_set(retval, SvCUR(retval)+2);
- esc_q_utf8(aTHX_ retval, c, i, 1, style->useqq);
+ esc_q_utf8(aTHX_ retval, c, i,
+#ifdef GvNAMEUTF8
+ !!GvNAMEUTF8(val)
+#else
+ 0
+#endif
+ , style->useqq);
sv_grow(retval, SvCUR(retval)+2);
r = SvPVX(retval)+SvCUR(retval);
r[0] = '}'; r[1] = '\0';
i = 1;
- }
- else
-#endif
- {
- sv_grow(retval, SvCUR(retval)+6+2*i);
- r = SvPVX(retval)+SvCUR(retval);
- r[0] = '*'; r[1] = '{'; r[2] = '\'';
- i += esc_q(r+3, c, i);
- i += 3;
- r[i++] = '\''; r[i++] = '}';
- r[i] = '\0';
- }
}
else {
sv_grow(retval, SvCUR(retval)+i+2);
diff --git a/t/dumper.t b/t/dumper.t
index 643160a..0c12f34 100644
--- a/t/dumper.t
+++ b/t/dumper.t
@@ -108,7 +108,7 @@ sub SKIP_TEST {
++$TNUM; print "ok $TNUM # skip $reason\n";
}
-$TMAX = 450;
+$TMAX = 456;
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
# it direct. Out here it lets us knobble the next if to test that the perl
@@ -1740,3 +1740,36 @@ EOT
TEST (qq(Dumper("\n")), '\n alone');
TEST (qq(Data::Dumper::DumperX("\n")), '\n alone') if $XS;
}
+#############
+our @globs = map { $_, \$_ } map { *$_ } map { $_, "s::$_" }
+ "foo", "\1bar", "L\x{e9}on", "m\x{100}cron", "snow\x{2603}";
+$WANT = <<'EOT';
+#$globs = [
+# *::foo,
+# \*::foo,
+# *s::foo,
+# \*s::foo,
+# *{"::\1bar"},
+# \*{"::\1bar"},
+# *{"s::\1bar"},
+# \*{"s::\1bar"},
+# *{"::L\351on"},
+# \*{"::L\351on"},
+# *{"s::L\351on"},
+# \*{"s::L\351on"},
+# *{"::m\x{100}cron"},
+# \*{"::m\x{100}cron"},
+# *{"s::m\x{100}cron"},
+# \*{"s::m\x{100}cron"},
+# *{"::snow\x{2603}"},
+# \*{"::snow\x{2603}"},
+# *{"s::snow\x{2603}"},
+# \*{"s::snow\x{2603}"}
+#];
+EOT
+{
+ local $Data::Dumper::Useqq = 1;
+ TEST (q(Data::Dumper->Dump([\@globs], ["globs"])), 'globs: Dump()');
+ TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
+ if $XS;
+}
--
2.13.6

19
perl-Data-Dumper.spec
View File

@ -1,21 +1,15 @@
%global cpan_version 2.161
Name: perl-Data-Dumper
Version: 2.167
Release: 399%{?dist}
Version: 2.170
Release: 1%{?dist}
Summary: Stringify perl data structures, suitable for printing and eval
License: GPL+ or Artistic
URL: http://search.cpan.org/dist/Data-Dumper/
Source0: http://www.cpan.org/authors/id/S/SM/SMUELLER/Data-Dumper-%{cpan_version}.tar.gz
# Unbundled from perl-5.25.12, requires perl > 5.25.5
Patch0: Data-Dumper-2.161-Upgrade-to-2.167.patch
# Allow building against perl <= 5.25.5,
# required for Data-Dumper-2.161-Upgrade-to-2.167.patch
Patch1: Data-Dumper-2.167-Provide-SvPVCLEAR-macro.patch
# Fix quoting glob names, RT#119831, in upstream after perl-5.27.6
Patch2: Data-Dumper-2.167-in-Data-Dumper-quote-glob-names-better.patch
# Fix postentry for quoted glob, bug #1532524, RT#132695,
# in upstream after perl-5.27.7
Patch3: Data-Dumper-2.167-fix-Data-Dumper-postentry-for-quoted-glob.patch
# Unbundled from perl 5.28.0-RC1
Patch1: Data-Dumper-2.167-Upgrade-to-2.170.patch
BuildRequires: findutils
BuildRequires: gcc
BuildRequires: make
@ -64,8 +58,6 @@ structures correctly.
%setup -q -n Data-Dumper-%{cpan_version}
%patch0 -p1
%patch1 -p1
%patch2 -p1
%patch3 -p1
sed -i '/MAN3PODS/d' Makefile.PL
%build
@ -89,6 +81,9 @@ make test
%{_mandir}/man3/*
%changelog
* Wed May 23 2018 Jitka Plesnikova <jplesnik@redhat.com> - 2.170-1
- Upgrade to 2.170 as provided in perl-5.28.0-RC1
* Thu Feb 08 2018 Fedora Release Engineering <releng@fedoraproject.org> - 2.167-399
- Rebuilt for https://fedoraproject.org/wiki/Fedora_28_Mass_Rebuild