Upgrade to 2.170 as provided in perl-5.28.0-RC1
This commit is contained in:
parent
8e85cc7e61
commit
19782bfcf4
|
@ -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
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -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
|
|
||||||
|
|
|
@ -1,21 +1,15 @@
|
||||||
%global cpan_version 2.161
|
%global cpan_version 2.161
|
||||||
Name: perl-Data-Dumper
|
Name: perl-Data-Dumper
|
||||||
Version: 2.167
|
Version: 2.170
|
||||||
Release: 399%{?dist}
|
Release: 1%{?dist}
|
||||||
Summary: Stringify perl data structures, suitable for printing and eval
|
Summary: Stringify perl data structures, suitable for printing and eval
|
||||||
License: GPL+ or Artistic
|
License: GPL+ or Artistic
|
||||||
URL: http://search.cpan.org/dist/Data-Dumper/
|
URL: http://search.cpan.org/dist/Data-Dumper/
|
||||||
Source0: http://www.cpan.org/authors/id/S/SM/SMUELLER/Data-Dumper-%{cpan_version}.tar.gz
|
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
|
# Unbundled from perl-5.25.12, requires perl > 5.25.5
|
||||||
Patch0: Data-Dumper-2.161-Upgrade-to-2.167.patch
|
Patch0: Data-Dumper-2.161-Upgrade-to-2.167.patch
|
||||||
# Allow building against perl <= 5.25.5,
|
# Unbundled from perl 5.28.0-RC1
|
||||||
# required for Data-Dumper-2.161-Upgrade-to-2.167.patch
|
Patch1: Data-Dumper-2.167-Upgrade-to-2.170.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
|
|
||||||
BuildRequires: findutils
|
BuildRequires: findutils
|
||||||
BuildRequires: gcc
|
BuildRequires: gcc
|
||||||
BuildRequires: make
|
BuildRequires: make
|
||||||
|
@ -64,8 +58,6 @@ structures correctly.
|
||||||
%setup -q -n Data-Dumper-%{cpan_version}
|
%setup -q -n Data-Dumper-%{cpan_version}
|
||||||
%patch0 -p1
|
%patch0 -p1
|
||||||
%patch1 -p1
|
%patch1 -p1
|
||||||
%patch2 -p1
|
|
||||||
%patch3 -p1
|
|
||||||
sed -i '/MAN3PODS/d' Makefile.PL
|
sed -i '/MAN3PODS/d' Makefile.PL
|
||||||
|
|
||||||
%build
|
%build
|
||||||
|
@ -89,6 +81,9 @@ make test
|
||||||
%{_mandir}/man3/*
|
%{_mandir}/man3/*
|
||||||
|
|
||||||
%changelog
|
%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
|
* Thu Feb 08 2018 Fedora Release Engineering <releng@fedoraproject.org> - 2.167-399
|
||||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_28_Mass_Rebuild
|
- Rebuilt for https://fedoraproject.org/wiki/Fedora_28_Mass_Rebuild
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue