import perl-Data-Dumper-2.167-399.module_el8.1.0+225+978beb03

i8c-stream-5.26 changed/i8c-stream-5.26/perl-Data-Dumper-2.167-399.module_el8.1.0+225+978beb03
MSVSphere Packaging Team 10 months ago
commit 438f2c7f4f

1
.gitignore vendored

@ -0,0 +1 @@
SOURCES/Data-Dumper-2.161.tar.gz

@ -0,0 +1 @@
a20626bd76d293147dd8ff8afa88deafd2d26899 SOURCES/Data-Dumper-2.161.tar.gz

@ -0,0 +1,634 @@
From 9f38b6c605086a67f0d92591f8e8dc99bc1d9164 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 09:25:35 +0200
Subject: [PATCH] Upgrade to 2.167
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
Unbundled from perl-5.25.12.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
Changes | 14 +++++
Dumper.pm | 47 ++++++++---------
Dumper.xs | 167 +++++++++++++++++++++++++++++++++++++++++++++---------------
t/bugs.t | 37 +++++++++++++-
t/deparse.t | 22 ++++----
5 files changed, 207 insertions(+), 80 deletions(-)
diff --git a/Changes b/Changes
index f9ea53f..a5430d5 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,20 @@ Changes - public release history for Data::Dumper
=over 8
+=item 2,166 (Nov 29 2016)
+
+Reduce memory usage by not importing from Carp
+Reduce memory usage by removing unused overload require.
+
+=item 2.165 (Nov 20 2016)
+
+Remove impediment to compiling under C++11.
+
+=item 2.164 (Nov 12 2016)
+
+The XS implementation now handles the C<Deparse> option, so using it no
+longer forces use of the pure-Perl version.
+
=item 2.161 (Jul 11 2016)
Perl 5.12 fix/workaround until fixed PPPort release.
diff --git a/Dumper.pm b/Dumper.pm
index c71ad35..00f6326 100644
--- a/Dumper.pm
+++ b/Dumper.pm
@@ -10,16 +10,15 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.161'; # Don't forget to set version and release
+ $VERSION = '2.167'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
use 5.006_001;
require Exporter;
-require overload;
-use Carp;
+use Carp ();
BEGIN {
@ISA = qw(Exporter);
@@ -70,7 +69,7 @@ $Maxrecurse = 1000 unless defined $Maxrecurse;
sub new {
my($c, $v, $n) = @_;
- croak "Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])"
+ Carp::croak("Usage: PACKAGE->new(ARRAYREF, [ARRAYREF])")
unless (defined($v) && (ref($v) eq 'ARRAY'));
$n = [] unless (defined($n) && (ref($n) eq 'ARRAY'));
@@ -170,11 +169,11 @@ sub Seen {
$s->{seen}{$id} = [$k, $v];
}
else {
- carp "Only refs supported, ignoring non-ref item \$$k";
+ Carp::carp("Only refs supported, ignoring non-ref item \$$k");
}
}
else {
- carp "Value of ref must be defined; ignoring undefined item \$$k";
+ Carp::carp("Value of ref must be defined; ignoring undefined item \$$k");
}
}
return $s;
@@ -195,7 +194,7 @@ sub Values {
return $s;
}
else {
- croak "Argument to Values, if provided, must be array ref";
+ Carp::croak("Argument to Values, if provided, must be array ref");
}
}
else {
@@ -214,7 +213,7 @@ sub Names {
return $s;
}
else {
- croak "Argument to Names, if provided, must be array ref";
+ Carp::croak("Argument to Names, if provided, must be array ref");
}
}
else {
@@ -227,7 +226,6 @@ sub DESTROY {}
sub Dump {
return &Dumpxs
unless $Data::Dumper::Useperl || (ref($_[0]) && $_[0]->{useperl})
- || $Data::Dumper::Deparse || (ref($_[0]) && $_[0]->{deparse})
# Use pure perl version on earlier releases on EBCDIC platforms
|| (! $IS_ASCII && $] lt 5.021_010);
@@ -439,7 +437,7 @@ sub _dump {
if (ref($s->{sortkeys}) eq 'CODE') {
$keys = $s->{sortkeys}($val);
unless (ref($keys) eq 'ARRAY') {
- carp "Sortkeys subroutine did not return ARRAYREF";
+ Carp::carp("Sortkeys subroutine did not return ARRAYREF");
$keys = [];
}
}
@@ -487,16 +485,16 @@ sub _dump {
require B::Deparse;
my $sub = 'sub ' . (B::Deparse->new)->coderef2text($val);
$pad = $s->{sep} . $s->{pad} . $s->{apad} . $s->{xpad} x ($s->{level} - 1);
- $sub =~ s/\n/$pad/gse;
+ $sub =~ s/\n/$pad/gs;
$out .= $sub;
}
else {
$out .= 'sub { "DUMMY" }';
- carp "Encountered CODE ref, using dummy placeholder" if $s->{purity};
+ Carp::carp("Encountered CODE ref, using dummy placeholder") if $s->{purity};
}
}
else {
- croak "Can't handle '$realtype' type";
+ Carp::croak("Can't handle '$realtype' type");
}
if ($realpack and !$no_bless) { # we have a blessed ref
@@ -1212,9 +1210,10 @@ $Data::Dumper::Deparse I<or> $I<OBJ>->Deparse(I<[NEWVAL]>)
Can be set to a boolean value to control whether code references are
turned into perl source code. If set to a true value, C<B::Deparse>
-will be used to get the source of the code reference. Using this option
-will force using the Perl implementation of the dumper, since the fast
-XSUB implementation doesn't support it.
+will be used to get the source of the code reference. In older versions,
+using this option imposed a significant performance penalty when dumping
+parts of a data structure other than code references, but that is no
+longer the case.
Caution : use this option only if you know that your coderefs will be
properly reconstructed by C<B::Deparse>.
@@ -1435,15 +1434,9 @@ the C<Deparse> flag), an anonymous subroutine that
contains the string '"DUMMY"' will be inserted in its place, and a warning
will be printed if C<Purity> is set. You can C<eval> the result, but bear
in mind that the anonymous sub that gets created is just a placeholder.
-Someday, perl will have a switch to cache-on-demand the string
-representation of a compiled piece of code, I hope. If you have prior
-knowledge of all the code refs that your data structures are likely
-to have, you can use the C<Seen> method to pre-seed the internal reference
-table and make the dumped output point to them, instead. See L</EXAMPLES>
-above.
-
-The C<Deparse> flag makes Dump() run slower, since the XSUB
-implementation does not support it.
+Even using the C<Deparse> flag will in some cases produce results that
+behave differently after being passed to C<eval>; see the documentation
+for L<B::Deparse>.
SCALAR objects have the weirdest looking C<bless> workaround.
@@ -1466,13 +1459,13 @@ be to use the C<Sortkeys> filter of Data::Dumper.
Gurusamy Sarathy gsar@activestate.com
-Copyright (c) 1996-2016 Gurusamy Sarathy. All rights reserved.
+Copyright (c) 1996-2017 Gurusamy Sarathy. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.161 (July 11 2016)
+Version 2.167 (January 4 2017)
=head1 SEE ALSO
diff --git a/Dumper.xs b/Dumper.xs
index b22088f..0e7142e 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -63,6 +63,7 @@ typedef struct {
I32 useqq;
int use_sparse_seen_hash;
int trailingcomma;
+ int deparse;
} Style;
static STRLEN num_q (const char *s, STRLEN slen);
@@ -369,7 +370,7 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
UV k;
if (do_utf8
- && ! isASCII(*(U8*)s)
+ && ! isASCII(*s)
/* Exclude non-ASCII low ordinal controls. This should be
* optimized out by the compiler on ASCII platforms; if not
* could wrap it in a #ifdef EBCDIC, but better to avoid
@@ -387,11 +388,11 @@ esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
increment = (k == 0 && *s != '\0') ? 1 : UTF8SKIP(s);
#if PERL_VERSION < 10
- sprintf(r, "\\x{%"UVxf"}", k);
+ sprintf(r, "\\x{%" UVxf "}", k);
r += strlen(r);
/* my_sprintf is not supported by ppport.h */
#else
- r = r + my_sprintf(r, "\\x{%"UVxf"}", k);
+ r = r + my_sprintf(r, "\\x{%" UVxf "}", k);
#endif
continue;
}
@@ -505,6 +506,53 @@ sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
return sv;
}
+static SV *
+deparsed_output(pTHX_ SV *val)
+{
+ SV *text;
+ int n;
+ dSP;
+
+ /* This is passed to load_module(), which decrements its ref count and
+ * modifies it (so we also can't reuse it below) */
+ SV *pkg = newSVpvs("B::Deparse");
+
+ load_module(PERL_LOADMOD_NOIMPORT, pkg, 0);
+
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ mXPUSHs(newSVpvs("B::Deparse"));
+ PUTBACK;
+
+ n = call_method("new", G_SCALAR);
+ SPAGAIN;
+
+ if (n != 1) {
+ croak("B::Deparse->new returned %d items, but expected exactly 1", n);
+ }
+
+ PUSHMARK(SP - n);
+ XPUSHs(val);
+ PUTBACK;
+
+ n = call_method("coderef2text", G_SCALAR);
+ SPAGAIN;
+
+ if (n != 1) {
+ croak("$b_deparse->coderef2text returned %d items, but expected exactly 1", n);
+ }
+
+ text = POPs;
+ SvREFCNT_inc(text); /* the caller will mortalise this */
+
+ FREETMPS;
+
+ PUTBACK;
+
+ return text;
+}
+
/*
* This ought to be split into smaller functions. (it is one long function since
* it exactly parallels the perl version, which was one long thing for
@@ -565,14 +613,14 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
i = perl_call_method(SvPVX_const(style->freezer), G_EVAL|G_VOID|G_DISCARD);
SPAGAIN;
if (SvTRUE(ERRSV))
- warn("WARNING(Freezer method call failed): %"SVf"", ERRSV);
+ warn("WARNING(Freezer method call failed): %" SVf, ERRSV);
PUTBACK; FREETMPS; LEAVE;
}
ival = SvRV(val);
realtype = SvTYPE(ival);
#ifdef DD_USE_OLD_ID_FORMAT
- idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
+ idlen = my_snprintf(id, sizeof(id), "0x%" UVxf, PTR2UV(ival));
#else
id_buffer = PTR2UV(ival);
idlen = sizeof(id_buffer);
@@ -630,7 +678,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
#ifdef DD_USE_OLD_ID_FORMAT
warn("ref name not found for %s", id);
#else
- warn("ref name not found for 0x%"UVxf, PTR2UV(ival));
+ warn("ref name not found for 0x%" UVxf, PTR2UV(ival));
#endif
return 0;
}
@@ -848,10 +896,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
ilen = inamelen;
sv_setiv(ixsv, ix);
#if PERL_VERSION < 10
- (void) sprintf(iname+ilen, "%"IVdf, (IV)ix);
+ (void) sprintf(iname+ilen, "%" IVdf, (IV)ix);
ilen = strlen(iname);
#else
- ilen = ilen + my_sprintf(iname+ilen, "%"IVdf, (IV)ix);
+ ilen = ilen + my_sprintf(iname+ilen, "%" IVdf, (IV)ix);
#endif
iname[ilen++] = ']'; iname[ilen] = '\0';
if (style->indent >= 3) {
@@ -886,7 +934,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
SV *sname;
HE *entry = NULL;
char *key;
- STRLEN klen;
SV *hval;
AV *keys = NULL;
@@ -976,6 +1023,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
char *nkey_buffer = NULL;
STRLEN nticks = 0;
SV* keysv;
+ STRLEN klen;
STRLEN keylen;
STRLEN nlen;
bool do_utf8 = FALSE;
@@ -1029,7 +1077,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (style->quotekeys || key_needs_quote(key,keylen)) {
if (do_utf8 || style->useqq) {
STRLEN ocur = SvCUR(retval);
- nlen = esc_q_utf8(aTHX_ retval, key, klen, do_utf8, style->useqq);
+ klen = nlen = esc_q_utf8(aTHX_ retval, key, klen, do_utf8, style->useqq);
nkey = SvPVX(retval) + ocur;
}
else {
@@ -1095,9 +1143,41 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
SvREFCNT_dec(totpad);
}
else if (realtype == SVt_PVCV) {
- sv_catpvs(retval, "sub { \"DUMMY\" }");
- if (style->purity)
- warn("Encountered CODE ref, using dummy placeholder");
+ if (style->deparse) {
+ SV *deparsed = sv_2mortal(deparsed_output(aTHX_ val));
+ SV *fullpad = sv_2mortal(newSVsv(style->sep));
+ const char *p;
+ STRLEN plen;
+ I32 i;
+
+ sv_catsv(fullpad, style->pad);
+ sv_catsv(fullpad, apad);
+ for (i = 0; i < level; i++) {
+ sv_catsv(fullpad, style->xpad);
+ }
+
+ sv_catpvs(retval, "sub ");
+ p = SvPV(deparsed, plen);
+ while (plen > 0) {
+ const char *nl = (const char *) memchr(p, '\n', plen);
+ if (!nl) {
+ sv_catpvn(retval, p, plen);
+ break;
+ }
+ else {
+ size_t n = nl - p;
+ sv_catpvn(retval, p, n);
+ sv_catsv(retval, fullpad);
+ p += n + 1;
+ plen -= n + 1;
+ }
+ }
+ }
+ else {
+ sv_catpvs(retval, "sub { \"DUMMY\" }");
+ if (style->purity)
+ warn("Encountered CODE ref, using dummy placeholder");
+ }
}
else {
warn("cannot handle ref type %d", (int)realtype);
@@ -1144,7 +1224,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (namelen) {
#ifdef DD_USE_OLD_ID_FORMAT
- idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(val));
+ idlen = my_snprintf(id, sizeof(id), "0x%" UVxf, PTR2UV(val));
#else
id_buffer = PTR2UV(val);
idlen = sizeof(id_buffer);
@@ -1184,9 +1264,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (DD_is_integer(val)) {
STRLEN len;
if (SvIsUV(val))
- len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"UVuf, SvUV(val));
+ len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%" UVuf, SvUV(val));
else
- len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, SvIV(val));
+ len = my_snprintf(tmpbuf, sizeof(tmpbuf), "%" IVdf, SvIV(val));
if (SvPOK(val)) {
/* Need to check to see if this is a string such as " 0".
I'm assuming from sprintf isn't going to clash with utf8. */
@@ -1412,53 +1492,55 @@ Data_Dumper_Dumpxs(href, ...)
&& (hv = (HV*)SvRV((SV*)href))
&& SvTYPE(hv) == SVt_PVHV) {
- if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
+ if ((svp = hv_fetchs(hv, "seen", FALSE)) && SvROK(*svp))
seenhv = (HV*)SvRV(*svp);
else
style.use_sparse_seen_hash = 1;
- if ((svp = hv_fetch(hv, "noseen", 6, FALSE)))
+ if ((svp = hv_fetchs(hv, "noseen", FALSE)))
style.use_sparse_seen_hash = (SvOK(*svp) && SvIV(*svp) != 0);
- if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
+ if ((svp = hv_fetchs(hv, "todump", FALSE)) && SvROK(*svp))
todumpav = (AV*)SvRV(*svp);
- if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
+ if ((svp = hv_fetchs(hv, "names", FALSE)) && SvROK(*svp))
namesav = (AV*)SvRV(*svp);
- if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
+ if ((svp = hv_fetchs(hv, "indent", FALSE)))
style.indent = SvIV(*svp);
- if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
+ if ((svp = hv_fetchs(hv, "purity", FALSE)))
style.purity = SvIV(*svp);
- if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
+ if ((svp = hv_fetchs(hv, "terse", FALSE)))
terse = SvTRUE(*svp);
- if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
+ if ((svp = hv_fetchs(hv, "useqq", FALSE)))
style.useqq = SvTRUE(*svp);
- if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
+ if ((svp = hv_fetchs(hv, "pad", FALSE)))
style.pad = *svp;
- if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
+ if ((svp = hv_fetchs(hv, "xpad", FALSE)))
style.xpad = *svp;
- if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
+ if ((svp = hv_fetchs(hv, "apad", FALSE)))
apad = *svp;
- if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
+ if ((svp = hv_fetchs(hv, "sep", FALSE)))
style.sep = *svp;
- if ((svp = hv_fetch(hv, "pair", 4, FALSE)))
+ if ((svp = hv_fetchs(hv, "pair", FALSE)))
style.pair = *svp;
- if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
+ if ((svp = hv_fetchs(hv, "varname", FALSE)))
varname = *svp;
- if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
+ if ((svp = hv_fetchs(hv, "freezer", FALSE)))
style.freezer = *svp;
- if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
+ if ((svp = hv_fetchs(hv, "toaster", FALSE)))
style.toaster = *svp;
- if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
+ if ((svp = hv_fetchs(hv, "deepcopy", FALSE)))
style.deepcopy = SvTRUE(*svp);
- if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
+ if ((svp = hv_fetchs(hv, "quotekeys", FALSE)))
style.quotekeys = SvTRUE(*svp);
- if ((svp = hv_fetch(hv, "trailingcomma", 13, FALSE)))
+ if ((svp = hv_fetchs(hv, "trailingcomma", FALSE)))
style.trailingcomma = SvTRUE(*svp);
- if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
+ if ((svp = hv_fetchs(hv, "deparse", FALSE)))
+ style.deparse = SvTRUE(*svp);
+ if ((svp = hv_fetchs(hv, "bless", FALSE)))
style.bless = *svp;
- if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
+ if ((svp = hv_fetchs(hv, "maxdepth", FALSE)))
style.maxdepth = SvIV(*svp);
- if ((svp = hv_fetch(hv, "maxrecurse", 10, FALSE)))
+ if ((svp = hv_fetchs(hv, "maxrecurse", FALSE)))
style.maxrecurse = SvIV(*svp);
- if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
+ if ((svp = hv_fetchs(hv, "sortkeys", FALSE))) {
SV *sv = *svp;
if (! SvTRUE(sv))
style.sortkeys = NULL;
@@ -1525,9 +1607,10 @@ Data_Dumper_Dumpxs(href, ...)
}
else {
STRLEN nchars;
- sv_setpvn(name, "$", 1);
+ sv_setpvs(name, "$");
sv_catsv(name, varname);
- nchars = my_snprintf(tmpbuf, sizeof(tmpbuf), "%"IVdf, (IV)(i+1));
+ nchars = my_snprintf(tmpbuf, sizeof(tmpbuf), "%" IVdf,
+ (IV)(i+1));
sv_catpvn(name, tmpbuf, nchars);
}
@@ -1575,7 +1658,7 @@ Data_Dumper_Dumpxs(href, ...)
sv_catpvs(retval, ";");
sv_catsv(retval, style.sep);
}
- sv_setpvn(valstr, "", 0);
+ SvPVCLEAR(valstr);
if (gimme == G_ARRAY) {
XPUSHs(sv_2mortal(retval));
if (i < imax) /* not the last time thro ? */
diff --git a/t/bugs.t b/t/bugs.t
index a440b0a..5db82da 100644
--- a/t/bugs.t
+++ b/t/bugs.t
@@ -12,7 +12,7 @@ BEGIN {
}
use strict;
-use Test::More tests => 15;
+use Test::More tests => 24;
use Data::Dumper;
{
@@ -144,4 +144,39 @@ SKIP: {
&$tests;
}
+{ # https://rt.perl.org/Ticket/Display.html?id=128524
+ my $want;
+ my $runtime = "runtime";
+ my $requires = "requires";
+ utf8::upgrade(my $uruntime = $runtime);
+ utf8::upgrade(my $urequires = $requires);
+ for my $run ($runtime, $uruntime) {
+ for my $req ($requires, $urequires) {
+ my $data = { $run => { $req => { foo => "bar" } } };
+ local $Data::Dumper::Useperl = 1;
+ # we want them all the same
+ defined $want or $want = Dumper($data);
+ is(Dumper( $data ), $want, "utf-8 indents");
+ SKIP:
+ {
+ defined &Data::Dumper::Dumpxs
+ or skip "No XS available", 1;
+ local $Data::Dumper::Useperl = 0;
+ is(Dumper( $data ), $want, "utf8-indents");
+ }
+ }
+ }
+}
+
+# RT#130487 - stack management bug in XS deparse
+SKIP: {
+ skip "No XS available", 1 if !defined &Data::Dumper::Dumpxs;
+ sub rt130487_args { 0 + @_ }
+ my $code = sub {};
+ local $Data::Dumper::Useperl = 0;
+ local $Data::Dumper::Deparse = 1;
+ my $got = rt130487_args( Dumper($code) );
+ is($got, 1, "stack management in XS deparse works, rt 130487");
+}
+
# EOF
diff --git a/t/deparse.t b/t/deparse.t
index c281fce..cddde8c 100644
--- a/t/deparse.t
+++ b/t/deparse.t
@@ -15,7 +15,7 @@ BEGIN {
use strict;
use Data::Dumper;
-use Test::More tests => 8;
+use Test::More tests => 16;
use lib qw( ./t/lib );
use Testing qw( _dumptostr );
@@ -24,7 +24,9 @@ use Testing qw( _dumptostr );
note("\$Data::Dumper::Deparse and Deparse()");
-{
+for my $useperl (0, 1) {
+ local $Data::Dumper::Useperl = $useperl;
+
my ($obj, %dumps, $deparse, $starting);
use strict;
my $struct = { foo => "bar\nbaz", quux => sub { "fleem" } };
@@ -46,11 +48,11 @@ note("\$Data::Dumper::Deparse and Deparse()");
$dumps{'objzero'} = _dumptostr($obj);
is($dumps{'noprev'}, $dumps{'dddzero'},
- "No previous setting and \$Data::Dumper::Deparse = 0 are equivalent");
+ "No previous setting and \$Data::Dumper::Deparse = 0 are equivalent (useperl=$useperl)");
is($dumps{'noprev'}, $dumps{'objempty'},
- "No previous setting and Deparse() are equivalent");
+ "No previous setting and Deparse() are equivalent (useperl=$useperl)");
is($dumps{'noprev'}, $dumps{'objzero'},
- "No previous setting and Deparse(0) are equivalent");
+ "No previous setting and Deparse(0) are equivalent (useperl=$useperl)");
local $Data::Dumper::Deparse = 1;
$obj = Data::Dumper->new( [ $struct ] );
@@ -62,19 +64,19 @@ note("\$Data::Dumper::Deparse and Deparse()");
$dumps{'objone'} = _dumptostr($obj);
is($dumps{'dddtrue'}, $dumps{'objone'},
- "\$Data::Dumper::Deparse = 1 and Deparse(1) are equivalent");
+ "\$Data::Dumper::Deparse = 1 and Deparse(1) are equivalent (useperl=$useperl)");
isnt($dumps{'dddzero'}, $dumps{'dddtrue'},
- "\$Data::Dumper::Deparse = 0 differs from \$Data::Dumper::Deparse = 1");
+ "\$Data::Dumper::Deparse = 0 differs from \$Data::Dumper::Deparse = 1 (useperl=$useperl)");
like($dumps{'dddzero'},
qr/quux.*?sub.*?DUMMY/s,
- "\$Data::Dumper::Deparse = 0 reports DUMMY instead of deparsing coderef");
+ "\$Data::Dumper::Deparse = 0 reports DUMMY instead of deparsing coderef (useperl=$useperl)");
unlike($dumps{'dddtrue'},
qr/quux.*?sub.*?DUMMY/s,
- "\$Data::Dumper::Deparse = 1 does not report DUMMY");
+ "\$Data::Dumper::Deparse = 1 does not report DUMMY (useperl=$useperl)");
like($dumps{'dddtrue'},
qr/quux.*?sub.*?use\sstrict.*?fleem/s,
- "\$Data::Dumper::Deparse = 1 deparses coderef");
+ "\$Data::Dumper::Deparse = 1 deparses coderef (useperl=$useperl)");
}
--
2.9.3

@ -0,0 +1,34 @@
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,112 @@
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

@ -0,0 +1,134 @@
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

@ -0,0 +1,215 @@
%global cpan_version 2.161
Name: perl-Data-Dumper
Version: 2.167
Release: 399%{?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
BuildRequires: findutils
BuildRequires: gcc
BuildRequires: make
BuildRequires: perl-devel
BuildRequires: perl-generators
BuildRequires: perl-interpreter
BuildRequires: perl(ExtUtils::MakeMaker) >= 6.76
BuildRequires: sed
# perl-Test-Simple is in cycle with perl-Data-Dumper
%if !%{defined perl_bootstrap}
# Run-time:
BuildRequires: perl(B::Deparse)
BuildRequires: perl(bytes)
BuildRequires: perl(Carp)
BuildRequires: perl(constant)
BuildRequires: perl(Exporter)
BuildRequires: perl(Scalar::Util)
BuildRequires: perl(XSLoader)
# Tests only:
BuildRequires: perl(Config)
BuildRequires: perl(if)
BuildRequires: perl(lib)
BuildRequires: perl(overload)
BuildRequires: perl(strict)
BuildRequires: perl(Test::More) >= 0.98
BuildRequires: perl(vars)
BuildRequires: perl(warnings)
# Optional tests:
BuildRequires: perl(Encode)
%endif
Requires: perl(:MODULE_COMPAT_%(eval "`perl -V:version`"; echo $version))
Requires: perl(B::Deparse)
Requires: perl(bytes)
Requires: perl(Scalar::Util)
Requires: perl(XSLoader)
%{?perl_default_filter}
%description
Given a list of scalars or reference variables, writes out their contents
in perl syntax. The references can also be objects. The content of each
variable is output in a single Perl statement. Handles self-referential
structures correctly.
%prep
%setup -q -n Data-Dumper-%{cpan_version}
%patch0 -p1
%patch1 -p1
%patch2 -p1
%patch3 -p1
sed -i '/MAN3PODS/d' Makefile.PL
%build
perl Makefile.PL INSTALLDIRS=vendor NO_PACKLIST=1 OPTIMIZE="$RPM_OPT_FLAGS"
make %{?_smp_mflags}
%install
make pure_install DESTDIR=$RPM_BUILD_ROOT
find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete
%{_fixperms} $RPM_BUILD_ROOT/*
%check
%if !%{defined perl_bootstrap}
make test
%endif
%files
%doc Changes Todo
%{perl_vendorarch}/auto/*
%{perl_vendorarch}/Data*
%{_mandir}/man3/*
%changelog
* Thu Apr 25 2024 MSVSphere Packaging Team <packager@msvsphere-os.ru> - 2.167-399
- Rebuilt for MSVSphere 8.9
* Thu Feb 08 2018 Fedora Release Engineering <releng@fedoraproject.org> - 2.167-399
- Rebuilt for https://fedoraproject.org/wiki/Fedora_28_Mass_Rebuild
* Thu Jan 11 2018 Petr Pisar <ppisar@redhat.com> - 2.167-398
- Fix postentry for quoted glob (bug #1532524)
* Tue Dec 05 2017 Petr Pisar <ppisar@redhat.com> - 2.167-397
- Fix quoting glob names (RT#119831)
* Thu Aug 03 2017 Fedora Release Engineering <releng@fedoraproject.org> - 2.167-396
- Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Binutils_Mass_Rebuild
* Thu Jul 27 2017 Fedora Release Engineering <releng@fedoraproject.org> - 2.167-395
- Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Mass_Rebuild
* Wed Jun 07 2017 Jitka Plesnikova <jplesnik@redhat.com> - 2.167-394
- Perl 5.26 re-rebuild of bootstrapped packages
* Sat Jun 03 2017 Jitka Plesnikova <jplesnik@redhat.com> - 2.167-393
- Perl 5.26 rebuild
* Thu May 11 2017 Petr Pisar <ppisar@redhat.com> - 2.167-1
- Upgrade to 2.167 as provided in perl-5.25.12
* Sat Feb 11 2017 Fedora Release Engineering <releng@fedoraproject.org> - 2.161-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_26_Mass_Rebuild
* Tue Jul 12 2016 Petr Pisar <ppisar@redhat.com> - 2.161-1
- 1.161 bump
* Wed May 18 2016 Jitka Plesnikova <jplesnik@redhat.com> - 2.160-366
- Perl 5.24 re-rebuild of bootstrapped packages
* Sat May 14 2016 Jitka Plesnikova <jplesnik@redhat.com> - 2.160-365
- Increase release to favour standalone package
* Wed May 11 2016 Jitka Plesnikova <jplesnik@redhat.com> - 2.160-1
- 2.160 bump in order to dual-live with perl 5.24
* Thu Feb 04 2016 Fedora Release Engineering <releng@fedoraproject.org> - 2.158-348
- Rebuilt for https://fedoraproject.org/wiki/Fedora_24_Mass_Rebuild
* Thu Jun 18 2015 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.158-347
- Rebuilt for https://fedoraproject.org/wiki/Fedora_23_Mass_Rebuild
* Wed Jun 10 2015 Jitka Plesnikova <jplesnik@redhat.com> - 2.158-346
- Perl 5.22 re-rebuild of bootstrapped packages
* Thu Jun 04 2015 Jitka Plesnikova <jplesnik@redhat.com> - 2.158-345
- Increase release to favour standalone package
* Wed Jun 03 2015 Jitka Plesnikova <jplesnik@redhat.com> - 2.158-2
- Perl 5.22 rebuild
* Wed May 06 2015 Petr Pisar <ppisar@redhat.com> - 2.158-1
- 2.158 bump in order to dual-live with perl 5.22
* Fri Sep 19 2014 Petr Pisar <ppisar@redhat.com> - 2.154-1
- 2.154 bump (fixes CVE-2014-4330 (limit recursion when dumping deep data
structures))
* Sun Sep 07 2014 Jitka Plesnikova <jplesnik@redhat.com> - 2.151-311
- Perl 5.20 re-rebuild of bootstrapped packages
* Wed Sep 03 2014 Jitka Plesnikova <jplesnik@redhat.com> - 2.151-310
- Increase release to favour standalone package
* Tue Aug 26 2014 Jitka Plesnikova <jplesnik@redhat.com> - 2.151-4
- Perl 5.20 rebuild
* Sun Aug 17 2014 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.151-3
- Rebuilt for https://fedoraproject.org/wiki/Fedora_21_22_Mass_Rebuild
* Sat Jun 07 2014 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.151-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_21_Mass_Rebuild
* Mon Mar 10 2014 Petr Pisar <ppisar@redhat.com> - 2.151-1
- 2.151 bump
* Wed Aug 14 2013 Jitka Plesnikova <jplesnik@redhat.com> - 2.145-292
- Perl 5.18 re-rebuild of bootstrapped packages
* Sat Aug 03 2013 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.145-291
- Rebuilt for https://fedoraproject.org/wiki/Fedora_20_Mass_Rebuild
* Mon Jul 15 2013 Petr Pisar <ppisar@redhat.com> - 2.145-290
- Increase release to favour standalone package
* Fri Jul 12 2013 Petr Pisar <ppisar@redhat.com> - 2.145-2
- Perl 5.18 rebuild
* Mon Mar 18 2013 Petr Pisar <ppisar@redhat.com> - 2.145-1
- 2.145 bump
* Thu Feb 28 2013 Petr Pisar <ppisar@redhat.com> - 2.143-1
- 2.143 bump
* Thu Feb 14 2013 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.139-2
- Rebuilt for https://fedoraproject.org/wiki/Fedora_19_Mass_Rebuild
* Wed Dec 12 2012 Petr Pisar <ppisar@redhat.com> - 2.139-1
- 2.139 bump
* Fri Oct 05 2012 Petr Pisar <ppisar@redhat.com> - 2.136-1
- 2.136 bump
* Fri Aug 24 2012 Petr Pisar <ppisar@redhat.com> - 2.135.07-241
- Disable tests on bootstrap
* Mon Aug 13 2012 Marcela Mašláňová <mmaslano@redhat.com> - 2.135.07-240
- update the version to override the module from perl.srpm
- bump release to override sub-package from perl.spec
* Fri Jul 20 2012 Fedora Release Engineering <rel-eng@lists.fedoraproject.org> - 2.131-3
- Rebuilt for https://fedoraproject.org/wiki/Fedora_18_Mass_Rebuild
* Wed Jun 06 2012 Petr Pisar <ppisar@redhat.com> - 2.131-2
- Perl 5.16 rebuild
* Tue Apr 10 2012 Petr Pisar <ppisar@redhat.com> 2.131-1
- Specfile autogenerated by cpanspec 1.78.
Loading…
Cancel
Save