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

1.161 bump

This commit is contained in:
Petr Písař 2016-07-12 09:45:21 +02:00
parent 8bf1d0b68e
commit 01499c2b7c
5 changed files with 15 additions and 2290 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitignore vendored
View File

@ -6,3 +6,4 @@
/Data-Dumper-2.145.tar.gz
/Data-Dumper-2.151.tar.gz
/Data-Dumper-2.154.tar.gz
/Data-Dumper-2.161.tar.gz

1347
Data-Dumper-2.154-Upgrade-to-2.158.patch
View File

File diff suppressed because it is too large Load Diff

929
Data-Dumper-2.158-Upgrade-to-2.160.patch
View File

@ -1,929 +0,0 @@
diff --git a/Dumper.pm b/Dumper.pm
index e884298..13be89d 100644
--- a/Dumper.pm
+++ b/Dumper.pm
@@ -10,7 +10,7 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.158'; # Don't forget to set version and release
+ $VERSION = '2.160'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
@@ -41,6 +41,7 @@ my $IS_ASCII = ord 'A' == 65;
# module vars and their defaults
$Indent = 2 unless defined $Indent;
+$Trailingcomma = 0 unless defined $Trailingcomma;
$Purity = 0 unless defined $Purity;
$Pad = "" unless defined $Pad;
$Varname = "VAR" unless defined $Varname;
@@ -76,6 +77,7 @@ sub new {
my($s) = {
level => 0, # current recursive depth
indent => $Indent, # various styles of indenting
+ trailingcomma => $Trailingcomma, # whether to add comma after last elem
pad => $Pad, # all lines prefixed by this string
xpad => "", # padding-per-level
apad => "", # added padding for hash keys n such
@@ -413,7 +415,9 @@ sub _dump {
$out .= $pad . $ipad . '#' . $i
if $s->{indent} >= 3;
$out .= $pad . $ipad . $s->_dump($v, $sname);
- $out .= "," if $i++ < $#$val;
+ $out .= ","
+ if $i++ < $#$val
+ || ($s->{trailingcomma} && $s->{indent} >= 1);
}
$out .= $pad . ($s->{xpad} x ($s->{level} - 1)) if $i;
$out .= ($name =~ /^\@/) ? ')' : ']';
@@ -473,7 +477,7 @@ sub _dump {
if $s->{indent} >= 2;
}
if (substr($out, -1) eq ',') {
- chop $out;
+ chop $out if !$s->{trailingcomma} || !$s->{indent};
$out .= $pad . ($s->{xpad} x ($s->{level} - 1));
}
$out .= ($name =~ /^\%/) ? ')' : '}';
@@ -633,6 +637,11 @@ sub Indent {
}
}
+sub Trailingcomma {
+ my($s, $v) = @_;
+ defined($v) ? (($s->{trailingcomma} = $v), return $s) : $s->{trailingcomma};
+}
+
sub Pair {
my($s, $v) = @_;
defined($v) ? (($s->{pair} = $v), return $s) : $s->{pair};
@@ -1032,6 +1041,15 @@ consumes twice the number of lines). Style 2 is the default.
=item *
+$Data::Dumper::Trailingcomma I<or> I<$OBJ>->Trailingcomma(I<[NEWVAL]>)
+
+Controls whether a comma is added after the last element of an array or
+hash. Even when true, no comma is added between the last element of an array
+or hash and a closing bracket when they appear on the same line. The default
+is false.
+
+=item *
+
$Data::Dumper::Purity I<or> I<$OBJ>->Purity(I<[NEWVAL]>)
Controls the degree to which the output can be C<eval>ed to recreate the
@@ -1454,7 +1472,7 @@ modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.158 (March 13 2015)
+Version 2.160 (January 12 2016)
=head1 SEE ALSO
diff --git a/Dumper.xs b/Dumper.xs
index 97277f4..8220241 100644
--- a/Dumper.xs
+++ b/Dumper.xs
@@ -41,19 +41,40 @@
|| (((UV) (c)) >= '0' && ((UV) (c)) <= '9'))
#endif
-static I32 num_q (const char *s, STRLEN slen);
-static I32 esc_q (char *dest, const char *src, STRLEN slen);
-static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq);
+/* 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
+ * stack all the time (as was the case in an earlier implementation). */
+typedef struct {
+ SV *pad;
+ SV *xpad;
+ SV *sep;
+ SV *pair;
+ SV *sortkeys;
+ SV *freezer;
+ SV *toaster;
+ SV *bless;
+ IV maxrecurse;
+ I32 indent;
+ I32 purity;
+ I32 deepcopy;
+ I32 quotekeys;
+ I32 maxdepth;
+ I32 useqq;
+ int use_sparse_seen_hash;
+ int trailingcomma;
+} Style;
+
+static STRLEN num_q (const char *s, STRLEN slen);
+static STRLEN esc_q (char *dest, const char *src, STRLEN slen);
+static STRLEN esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq);
static bool globname_needs_quote(const char *s, STRLEN len);
static bool key_needs_quote(const char *s, STRLEN len);
static bool safe_decimal_number(const char *p, STRLEN len);
static SV *sv_x (pTHX_ SV *sv, const char *str, STRLEN len, I32 n);
static I32 DD_dump (pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval,
- HV *seenhv, AV *postav, I32 *levelp, I32 indent,
- SV *pad, SV *xpad, SV *apad, SV *sep, SV *pair,
- SV *freezer, SV *toaster,
- I32 purity, I32 deepcopy, I32 quotekeys, SV *bless,
- I32 maxdepth, SV *sortkeys, int use_sparse_seen_hash, I32 useqq, IV maxrecurse);
+ HV *seenhv, AV *postav, const I32 level, SV *apad,
+ const Style *style);
#ifndef HvNAME_get
#define HvNAME_get HvNAME
@@ -196,10 +217,10 @@ safe_decimal_number(const char *p, STRLEN len) {
}
/* count the number of "'"s and "\"s in string */
-static I32
+static STRLEN
num_q(const char *s, STRLEN slen)
{
- I32 ret = 0;
+ STRLEN ret = 0;
while (slen > 0) {
if (*s == '\'' || *s == '\\')
@@ -214,10 +235,10 @@ num_q(const char *s, STRLEN slen)
/* returns number of chars added to escape "'"s and "\"s in s */
/* slen number of characters in s will be escaped */
/* destination must be long enough for additional chars */
-static I32
+static STRLEN
esc_q(char *d, const char *s, STRLEN slen)
{
- I32 ret = 0;
+ STRLEN ret = 0;
while (slen > 0) {
switch (*s) {
@@ -236,7 +257,7 @@ esc_q(char *d, const char *s, STRLEN slen)
}
/* this function is also misused for implementing $Useqq */
-static I32
+static STRLEN
esc_q_utf8(pTHX_ SV* sv, const char *src, STRLEN slen, I32 do_utf8, I32 useqq)
{
char *r, *rstart;
@@ -491,10 +512,7 @@ sv_x(pTHX_ SV *sv, const char *str, STRLEN len, I32 n)
*/
static I32
DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
- AV *postav, I32 *levelp, I32 indent, SV *pad, SV *xpad,
- SV *apad, SV *sep, SV *pair, SV *freezer, SV *toaster, I32 purity,
- I32 deepcopy, I32 quotekeys, SV *bless, I32 maxdepth, SV *sortkeys,
- int use_sparse_seen_hash, I32 useqq, IV maxrecurse)
+ AV *postav, const I32 level, SV *apad, const Style *style)
{
char tmpbuf[128];
Size_t i;
@@ -537,14 +555,14 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
/* If a freeze method is provided and the object has it, call
it. Warn on errors. */
- if (SvOBJECT(SvRV(val)) && freezer &&
- SvPOK(freezer) && SvCUR(freezer) &&
- gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(freezer),
- SvCUR(freezer), -1) != NULL)
+ if (SvOBJECT(SvRV(val)) && style->freezer &&
+ SvPOK(style->freezer) && SvCUR(style->freezer) &&
+ gv_fetchmeth(SvSTASH(SvRV(val)), SvPVX_const(style->freezer),
+ SvCUR(style->freezer), -1) != NULL)
{
dSP; ENTER; SAVETMPS; PUSHMARK(sp);
XPUSHs(val); PUTBACK;
- i = perl_call_method(SvPVX_const(freezer), G_EVAL|G_VOID|G_DISCARD);
+ 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);
@@ -575,7 +593,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if ((svp = av_fetch(seenentry, 0, FALSE))
&& (othername = *svp))
{
- if (purity && *levelp > 0) {
+ if (style->purity && level > 0) {
SV *postentry;
if (realtype == SVt_PVHV)
@@ -662,7 +680,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
* representation of the thing we are currently examining
* at this depth (i.e., 'Foo=ARRAY(0xdeadbeef)').
*/
- if (!purity && maxdepth > 0 && *levelp >= maxdepth) {
+ if (!style->purity && style->maxdepth > 0 && level >= style->maxdepth) {
STRLEN vallen;
const char * const valstr = SvPV(val,vallen);
sv_catpvs(retval, "'");
@@ -671,24 +689,23 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
return 1;
}
- if (maxrecurse > 0 && *levelp >= maxrecurse) {
- croak("Recursion limit of %" IVdf " exceeded", maxrecurse);
+ if (style->maxrecurse > 0 && level >= style->maxrecurse) {
+ croak("Recursion limit of %" IVdf " exceeded", style->maxrecurse);
}
if (realpack && !no_bless) { /* we have a blessed ref */
STRLEN blesslen;
- const char * const blessstr = SvPV(bless, blesslen);
+ const char * const blessstr = SvPV(style->bless, blesslen);
sv_catpvn(retval, blessstr, blesslen);
sv_catpvs(retval, "( ");
- if (indent >= 2) {
+ if (style->indent >= 2) {
blesspad = apad;
apad = newSVsv(apad);
sv_x(aTHX_ apad, " ", 1, blesslen+2);
}
}
- (*levelp)++;
- ipad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp);
+ ipad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad), SvCUR(style->xpad), level+1);
if (is_regex)
{
@@ -759,19 +776,13 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (realpack) { /* blessed */
sv_catpvs(retval, "do{\\(my $o = ");
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
- postav, levelp, indent, pad, xpad, apad, sep, pair,
- freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash, useqq,
- maxrecurse);
+ postav, level+1, apad, style);
sv_catpvs(retval, ")}");
} /* plain */
else {
sv_catpvs(retval, "\\");
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
- postav, levelp, indent, pad, xpad, apad, sep, pair,
- freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash, useqq,
- maxrecurse);
+ postav, level+1, apad, style);
}
SvREFCNT_dec(namesv);
}
@@ -781,10 +792,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(namesv, "}");
sv_catpvs(retval, "\\");
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
- postav, levelp, indent, pad, xpad, apad, sep, pair,
- freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash, useqq,
- maxrecurse);
+ postav, level+1, apad, style);
SvREFCNT_dec(namesv);
}
else if (realtype == SVt_PVAV) {
@@ -824,8 +832,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
iname[inamelen++] = '-'; iname[inamelen++] = '>';
}
iname[inamelen++] = '['; iname[inamelen] = '\0';
- totpad = newSVsv(sep);
- sv_catsv(totpad, pad);
+ totpad = newSVsv(style->sep);
+ sv_catsv(totpad, style->pad);
sv_catsv(totpad, apad);
for (ix = 0; ix <= ixmax; ++ix) {
@@ -846,7 +854,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
ilen = ilen + my_sprintf(iname+ilen, "%"IVdf, (IV)ix);
#endif
iname[ilen++] = ']'; iname[ilen] = '\0';
- if (indent >= 3) {
+ if (style->indent >= 3) {
sv_catsv(retval, totpad);
sv_catsv(retval, ipad);
sv_catpvs(retval, "#");
@@ -855,15 +863,12 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catsv(retval, totpad);
sv_catsv(retval, ipad);
DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
- levelp, indent, pad, xpad, apad, sep, pair,
- freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash,
- useqq, maxrecurse);
- if (ix < ixmax)
+ level+1, apad, style);
+ if (ix < ixmax || (style->trailingcomma && style->indent >= 1))
sv_catpvs(retval, ",");
}
if (ixmax >= 0) {
- SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), (*levelp)-1);
+ SV * const opad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad), SvCUR(style->xpad), level);
sv_catsv(retval, totpad);
sv_catsv(retval, opad);
SvREFCNT_dec(opad);
@@ -881,7 +886,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
SV *sname;
HE *entry = NULL;
char *key;
- I32 klen;
+ STRLEN klen;
SV *hval;
AV *keys = NULL;
@@ -909,16 +914,14 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvs(iname, "->");
}
sv_catpvs(iname, "{");
- totpad = newSVsv(sep);
- sv_catsv(totpad, pad);
+ totpad = newSVsv(style->sep);
+ sv_catsv(totpad, style->pad);
sv_catsv(totpad, apad);
/* If requested, get a sorted/filtered array of hash keys */
- if (sortkeys) {
- if (sortkeys == &PL_sv_yes) {
-#if PERL_VERSION < 8
- sortkeys = sv_2mortal(newSVpvs("Data::Dumper::_sortkeys"));
-#else
+ if (style->sortkeys) {
+#if PERL_VERSION >= 8
+ if (style->sortkeys == &PL_sv_yes) {
keys = newAV();
(void)hv_iterinit((HV*)ival);
while ((entry = hv_iternext((HV*)ival))) {
@@ -939,17 +942,18 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
else
# endif
-#endif
{
sortsv(AvARRAY(keys),
av_len(keys)+1,
Perl_sv_cmp);
}
}
- if (sortkeys != &PL_sv_yes) {
+ else
+#endif
+ {
dSP; ENTER; SAVETMPS; PUSHMARK(sp);
XPUSHs(sv_2mortal(newRV_inc(ival))); PUTBACK;
- i = perl_call_sv(sortkeys, G_SCALAR | G_EVAL);
+ i = perl_call_sv(style->sortkeys, G_SCALAR | G_EVAL);
SPAGAIN;
if (i) {
sv = POPs;
@@ -970,13 +974,13 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
for (i = 0; 1; i++) {
char *nkey;
char *nkey_buffer = NULL;
- I32 nticks = 0;
+ STRLEN nticks = 0;
SV* keysv;
STRLEN keylen;
- I32 nlen;
+ STRLEN nlen;
bool do_utf8 = FALSE;
- if (sortkeys) {
+ if (style->sortkeys) {
if (!(keys && (SSize_t)i <= av_len(keys))) break;
} else {
if (!(entry = hv_iternext((HV *)ival))) break;
@@ -985,7 +989,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
if (i)
sv_catpvs(retval, ",");
- if (sortkeys) {
+ if (style->sortkeys) {
char *key;
svp = av_fetch(keys, i, FALSE);
keysv = svp ? *svp : sv_newmortal();
@@ -1022,10 +1026,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
their handling of key quoting compatible between XS
and perl.
*/
- if (quotekeys || key_needs_quote(key,keylen)) {
- if (do_utf8 || useqq) {
+ 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, useqq);
+ nlen = esc_q_utf8(aTHX_ retval, key, klen, do_utf8, style->useqq);
nkey = SvPVX(retval) + ocur;
}
else {
@@ -1052,10 +1056,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvn(sname, nkey, nlen);
sv_catpvs(sname, "}");
- sv_catsv(retval, pair);
- if (indent >= 2) {
+ sv_catsv(retval, style->pair);
+ if (style->indent >= 2) {
char *extra;
- I32 elen = 0;
+ STRLEN elen = 0;
newapad = newSVsv(apad);
New(0, extra, klen+4+1, char);
while (elen < (klen+4))
@@ -1068,17 +1072,17 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
newapad = apad;
DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
- postav, levelp, indent, pad, xpad, newapad, sep, pair,
- freezer, toaster, purity, deepcopy, quotekeys, bless,
- maxdepth, sortkeys, use_sparse_seen_hash, useqq,
- maxrecurse);
+ postav, level+1, newapad, style);
SvREFCNT_dec(sname);
Safefree(nkey_buffer);
- if (indent >= 2)
+ if (style->indent >= 2)
SvREFCNT_dec(newapad);
}
if (i) {
- SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(xpad), SvCUR(xpad), *levelp-1);
+ SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad),
+ SvCUR(style->xpad), level);
+ if (style->trailingcomma && style->indent >= 1)
+ sv_catpvs(retval, ",");
sv_catsv(retval, totpad);
sv_catsv(retval, opad);
SvREFCNT_dec(opad);
@@ -1092,7 +1096,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
else if (realtype == SVt_PVCV) {
sv_catpvs(retval, "sub { \"DUMMY\" }");
- if (purity)
+ if (style->purity)
warn("Encountered CODE ref, using dummy placeholder");
}
else {
@@ -1100,10 +1104,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
if (realpack && !no_bless) { /* free blessed allocs */
- I32 plen;
- I32 pticks;
+ STRLEN plen, pticks;
- if (indent >= 2) {
+ if (style->indent >= 2) {
SvREFCNT_dec(apad);
apad = blesspad;
}
@@ -1127,14 +1130,13 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
sv_catpvn(retval, realpack, strlen(realpack));
}
sv_catpvs(retval, "' )");
- if (toaster && SvPOK(toaster) && SvCUR(toaster)) {
+ if (style->toaster && SvPOK(style->toaster) && SvCUR(style->toaster)) {
sv_catpvs(retval, "->");
- sv_catsv(retval, toaster);
+ sv_catsv(retval, style->toaster);
sv_catpvs(retval, "()");
}
}
SvREFCNT_dec(ipad);
- (*levelp)--;
}
else {
STRLEN i;
@@ -1168,7 +1170,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
* there is no other reference, duh. This is an optimization.
* Note that we'd have to check for weak-refs, too, but this is
* already the branch for non-refs only. */
- else if (val != &PL_sv_undef && (!use_sparse_seen_hash || SvREFCNT(val) > 1)) {
+ else if (val != &PL_sv_undef && (!style->use_sparse_seen_hash || SvREFCNT(val) > 1)) {
SV * const namesv = newSVpvs("\\");
sv_catpvn(namesv, name, namelen);
seenentry = newAV();
@@ -1219,7 +1221,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
r = SvPVX(retval)+SvCUR(retval);
r[0] = '*'; r[1] = '{';
SvCUR_set(retval, SvCUR(retval)+2);
- esc_q_utf8(aTHX_ retval, c, i, 1, useqq);
+ esc_q_utf8(aTHX_ retval, c, i, 1, style->useqq);
sv_grow(retval, SvCUR(retval)+2);
r = SvPVX(retval)+SvCUR(retval);
r[0] = '}'; r[1] = '\0';
@@ -1245,7 +1247,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
SvCUR_set(retval, SvCUR(retval)+i);
- if (purity) {
+ if (style->purity) {
static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
static const STRLEN sizes[] = { 8, 7, 6 };
SV *e;
@@ -1262,7 +1264,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
continue;
{
- I32 nlevel = 0;
SV *postentry = newSVpvn(r,i);
sv_setsv(nname, postentry);
@@ -1272,15 +1273,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
e = newRV_inc(e);
SvCUR_set(newapad, 0);
- if (indent >= 2)
+ if (style->indent >= 2)
(void)sv_x(aTHX_ newapad, " ", 1, SvCUR(postentry));
DD_dump(aTHX_ e, SvPVX_const(nname), SvCUR(nname), postentry,
- seenhv, postav, &nlevel, indent, pad, xpad,
- newapad, sep, pair, freezer, toaster, purity,
- deepcopy, quotekeys, bless, maxdepth,
- sortkeys, use_sparse_seen_hash, useqq,
- maxrecurse);
+ seenhv, postav, 0, newapad, style);
SvREFCNT_dec(e);
}
}
@@ -1315,11 +1312,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
* the pure perl code.
* see [perl #74798]
*/
- if (useqq && safe_decimal_number(c, i)) {
+ if (style->useqq && safe_decimal_number(c, i)) {
sv_catsv(retval, val);
}
- else if (DO_UTF8(val) || useqq)
- i += esc_q_utf8(aTHX_ retval, c, i, DO_UTF8(val), useqq);
+ else if (DO_UTF8(val) || style->useqq)
+ i += esc_q_utf8(aTHX_ retval, c, i, DO_UTF8(val), style->useqq);
else {
sv_grow(retval, SvCUR(retval)+3+2*i); /* 3: ""\0 */
r = SvPVX(retval) + SvCUR(retval);
@@ -1334,7 +1331,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
}
if (idlen) {
- if (deepcopy)
+ if (style->deepcopy)
(void)hv_delete(seenhv, id, idlen, G_DISCARD);
else if (namelen && seenentry) {
SV *mark = *av_fetch(seenentry, 2, TRUE);
@@ -1363,17 +1360,15 @@ Data_Dumper_Dumpxs(href, ...)
SV *retval, *valstr;
HV *seenhv = NULL;
AV *postav, *todumpav, *namesav;
- I32 level = 0;
- I32 indent, terse, useqq;
+ I32 terse = 0;
SSize_t i, imax, postlen;
SV **svp;
- SV *val, *name, *pad, *xpad, *apad, *sep, *pair, *varname;
- SV *freezer, *toaster, *bless, *sortkeys;
- I32 purity, deepcopy, quotekeys, maxdepth = 0;
- IV maxrecurse = 1000;
+ SV *apad = &PL_sv_undef;
+ Style style;
+
+ SV *name, *val = &PL_sv_undef, *varname = &PL_sv_undef;
char tmpbuf[1024];
I32 gimme = GIMME_V;
- int use_sparse_seen_hash = 0;
if (!SvROK(href)) { /* call new to get an object first */
if (items < 2)
@@ -1402,13 +1397,15 @@ Data_Dumper_Dumpxs(href, ...)
}
todumpav = namesav = NULL;
+ style.indent = 2;
+ style.quotekeys = 1;
+ style.maxrecurse = 1000;
+ style.purity = style.deepcopy = style.useqq = style.maxdepth
+ = style.use_sparse_seen_hash = style.trailingcomma = 0;
+ style.pad = style.xpad = style.sep = style.pair = style.sortkeys
+ = style.freezer = style.toaster = style.bless = &PL_sv_undef;
seenhv = NULL;
- val = pad = xpad = apad = sep = pair = varname
- = freezer = toaster = bless = sortkeys = &PL_sv_undef;
name = sv_newmortal();
- indent = 2;
- terse = purity = deepcopy = useqq = 0;
- quotekeys = 1;
retval = newSVpvs("");
if (SvROK(href)
@@ -1418,57 +1415,66 @@ Data_Dumper_Dumpxs(href, ...)
if ((svp = hv_fetch(hv, "seen", 4, FALSE)) && SvROK(*svp))
seenhv = (HV*)SvRV(*svp);
else
- use_sparse_seen_hash = 1;
+ style.use_sparse_seen_hash = 1;
if ((svp = hv_fetch(hv, "noseen", 6, FALSE)))
- use_sparse_seen_hash = (SvOK(*svp) && SvIV(*svp) != 0);
+ style.use_sparse_seen_hash = (SvOK(*svp) && SvIV(*svp) != 0);
if ((svp = hv_fetch(hv, "todump", 6, FALSE)) && SvROK(*svp))
todumpav = (AV*)SvRV(*svp);
if ((svp = hv_fetch(hv, "names", 5, FALSE)) && SvROK(*svp))
namesav = (AV*)SvRV(*svp);
if ((svp = hv_fetch(hv, "indent", 6, FALSE)))
- indent = SvIV(*svp);
+ style.indent = SvIV(*svp);
if ((svp = hv_fetch(hv, "purity", 6, FALSE)))
- purity = SvIV(*svp);
+ style.purity = SvIV(*svp);
if ((svp = hv_fetch(hv, "terse", 5, FALSE)))
terse = SvTRUE(*svp);
if ((svp = hv_fetch(hv, "useqq", 5, FALSE)))
- useqq = SvTRUE(*svp);
+ style.useqq = SvTRUE(*svp);
if ((svp = hv_fetch(hv, "pad", 3, FALSE)))
- pad = *svp;
+ style.pad = *svp;
if ((svp = hv_fetch(hv, "xpad", 4, FALSE)))
- xpad = *svp;
+ style.xpad = *svp;
if ((svp = hv_fetch(hv, "apad", 4, FALSE)))
apad = *svp;
if ((svp = hv_fetch(hv, "sep", 3, FALSE)))
- sep = *svp;
+ style.sep = *svp;
if ((svp = hv_fetch(hv, "pair", 4, FALSE)))
- pair = *svp;
+ style.pair = *svp;
if ((svp = hv_fetch(hv, "varname", 7, FALSE)))
varname = *svp;
if ((svp = hv_fetch(hv, "freezer", 7, FALSE)))
- freezer = *svp;
+ style.freezer = *svp;
if ((svp = hv_fetch(hv, "toaster", 7, FALSE)))
- toaster = *svp;
+ style.toaster = *svp;
if ((svp = hv_fetch(hv, "deepcopy", 8, FALSE)))
- deepcopy = SvTRUE(*svp);
+ style.deepcopy = SvTRUE(*svp);
if ((svp = hv_fetch(hv, "quotekeys", 9, FALSE)))
- quotekeys = SvTRUE(*svp);
+ style.quotekeys = SvTRUE(*svp);
+ if ((svp = hv_fetch(hv, "trailingcomma", 13, FALSE)))
+ style.trailingcomma = SvTRUE(*svp);
if ((svp = hv_fetch(hv, "bless", 5, FALSE)))
- bless = *svp;
+ style.bless = *svp;
if ((svp = hv_fetch(hv, "maxdepth", 8, FALSE)))
- maxdepth = SvIV(*svp);
+ style.maxdepth = SvIV(*svp);
if ((svp = hv_fetch(hv, "maxrecurse", 10, FALSE)))
- maxrecurse = SvIV(*svp);
+ style.maxrecurse = SvIV(*svp);
if ((svp = hv_fetch(hv, "sortkeys", 8, FALSE))) {
- sortkeys = *svp;
- if (! SvTRUE(sortkeys))
- sortkeys = NULL;
- else if (! (SvROK(sortkeys) &&
- SvTYPE(SvRV(sortkeys)) == SVt_PVCV) )
- {
- /* flag to use qsortsv() for sorting hash keys */
- sortkeys = &PL_sv_yes;
- }
+ SV *sv = *svp;
+ if (! SvTRUE(sv))
+ style.sortkeys = NULL;
+ else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV)
+ style.sortkeys = sv;
+ else if (PERL_VERSION < 8)
+ /* 5.6 doesn't make sortsv() available to XS code,
+ * so we must use this helper instead. Note that we
+ * always allocate this mortal SV, but it will be
+ * used only if at least one hash is encountered
+ * while dumping recursively; an older version
+ * allocated it lazily as needed. */
+ style.sortkeys = sv_2mortal(newSVpvs("Data::Dumper::_sortkeys"));
+ else
+ /* flag to use sortsv() for sorting hash keys */
+ style.sortkeys = &PL_sv_yes;
}
postav = newAV();
@@ -1525,7 +1531,7 @@ Data_Dumper_Dumpxs(href, ...)
sv_catpvn(name, tmpbuf, nchars);
}
- if (indent >= 2 && !terse) {
+ if (style.indent >= 2 && !terse) {
SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
newapad = newSVsv(apad);
sv_catsv(newapad, tmpsv);
@@ -1536,13 +1542,10 @@ Data_Dumper_Dumpxs(href, ...)
PUTBACK;
DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
- postav, &level, indent, pad, xpad, newapad, sep, pair,
- freezer, toaster, purity, deepcopy, quotekeys,
- bless, maxdepth, sortkeys, use_sparse_seen_hash,
- useqq, maxrecurse);
+ postav, 0, newapad, &style);
SPAGAIN;
- if (indent >= 2 && !terse)
+ if (style.indent >= 2 && !terse)
SvREFCNT_dec(newapad);
postlen = av_len(postav);
@@ -1551,12 +1554,12 @@ Data_Dumper_Dumpxs(href, ...)
sv_insert(valstr, 0, 0, SvPVX_const(name), SvCUR(name));
sv_catpvs(valstr, ";");
}
- sv_catsv(retval, pad);
+ sv_catsv(retval, style.pad);
sv_catsv(retval, valstr);
- sv_catsv(retval, sep);
+ sv_catsv(retval, style.sep);
if (postlen >= 0) {
SSize_t i;
- sv_catsv(retval, pad);
+ sv_catsv(retval, style.pad);
for (i = 0; i <= postlen; ++i) {
SV *elem;
svp = av_fetch(postav, i, FALSE);
@@ -1564,13 +1567,13 @@ Data_Dumper_Dumpxs(href, ...)
sv_catsv(retval, elem);
if (i < postlen) {
sv_catpvs(retval, ";");
- sv_catsv(retval, sep);
- sv_catsv(retval, pad);
+ sv_catsv(retval, style.sep);
+ sv_catsv(retval, style.pad);
}
}
}
sv_catpvs(retval, ";");
- sv_catsv(retval, sep);
+ sv_catsv(retval, style.sep);
}
sv_setpvn(valstr, "", 0);
if (gimme == G_ARRAY) {
diff --git a/t/huge.t b/t/huge.t
new file mode 100644
index 0000000..09343b7
--- /dev/null
+++ b/t/huge.t
@@ -0,0 +1,33 @@
+#!./perl -w
+#
+# automated tests for Data::Dumper that need large amounts of memory; they
+# are skipped unless PERL_TEST_MEMORY is set, and at least 10
+#
+
+use strict;
+use warnings;
+
+use Test::More;
+
+use Config;
+use Data::Dumper;
+
+BEGIN {
+ plan skip_all => 'Data::Dumper was not built'
+ if $Config{extensions} !~ m{\b Data/Dumper \b}x;
+ plan skip_all => 'Need 64-bit pointers for this test'
+ if $Config{ptrsize} < 8;
+ plan skip_all => 'Need ~10 GiB of core for this test'
+ if !$ENV{PERL_TEST_MEMORY} || $ENV{PERL_TEST_MEMORY} < 10;
+}
+
+plan tests => 1;
+
+{
+ my $input = q/'/ x 2**31;
+ my $len = length Dumper($input);
+ # Each single-quote will get backslashed, so the output must have
+ # stricly more than twice as many characters as the input.
+ cmp_ok($len, '>', 2**32, 'correct output for huge all-quotable value');
+ undef $input;
+}
diff --git a/t/trailing_comma.t b/t/trailing_comma.t
new file mode 100644
index 0000000..8767bdf
--- /dev/null
+++ b/t/trailing_comma.t
@@ -0,0 +1,116 @@
+#!./perl -w
+# t/trailing_comma.t - Test TrailingComma()
+
+BEGIN {
+ if ($ENV{PERL_CORE}){
+ require Config; import Config;
+ no warnings 'once';
+ if ($Config{'extensions'} !~ /\bData\/Dumper\b/) {
+ print "1..0 # Skip: Data::Dumper was not built\n";
+ exit 0;
+ }
+ }
+}
+
+use strict;
+
+use Data::Dumper;
+use Test::More;
+use lib qw( ./t/lib );
+use Testing qw( _dumptostr );
+
+my @cases = ({
+ input => [],
+ output => "[]",
+ desc => 'empty array',
+}, {
+ input => [17],
+ output => "[17]",
+ desc => 'single-element array, no indent',
+ conf => { Indent => 0 },
+}, {
+ input => [17],
+ output => "[\n 17,\n]",
+ desc => 'single-element array, indent=1',
+ conf => { Indent => 1 },
+}, {
+ input => [17],
+ output => "[\n 17,\n ]",
+ desc => 'single-element array, indent=2',
+ conf => { Indent => 2 },
+}, {
+ input => [17, 18],
+ output => "[17,18]",
+ desc => 'two-element array, no indent',
+ conf => { Indent => 0 },
+}, {
+ input => [17, 18],
+ output => "[\n 17,\n 18,\n]",
+ desc => 'two-element array, indent=1',
+ conf => { Indent => 1 },
+}, {
+ input => [17, 18],
+ output => "[\n 17,\n 18,\n ]",
+ desc => 'two-element array, indent=2',
+ conf => { Indent => 2 },
+}, {
+ input => {},
+ output => "{}",
+ desc => 'empty hash',
+}, {
+ input => {foo => 17},
+ output => "{'foo' => 17}",
+ desc => 'single-element hash, no indent',
+ conf => { Indent => 0 },
+}, {
+ input => {foo => 17},
+ output => "{\n 'foo' => 17,\n}",
+ desc => 'single-element hash, indent=1',
+ conf => { Indent => 1 },
+}, {
+ input => {foo => 17},
+ output => "{\n 'foo' => 17,\n }",
+ desc => 'single-element hash, indent=2',
+ conf => { Indent => 2 },
+}, {
+ input => {foo => 17, quux => 18},
+ output => "{'foo' => 17,'quux' => 18}",
+ desc => 'two-element hash, no indent',
+ conf => { Indent => 0 },
+}, {
+ input => {foo => 17, quux => 18},
+ output => "{\n 'foo' => 17,\n 'quux' => 18,\n}",
+ desc => 'two-element hash, indent=1',
+ conf => { Indent => 1 },
+}, {
+ input => {foo => 17, quux => 18},
+ output => "{\n 'foo' => 17,\n 'quux' => 18,\n }",
+ desc => 'two-element hash, indent=2',
+ conf => { Indent => 2 },
+});
+
+my $xs_available = !$Data::Dumper::Useperl;
+my $tests_per_case = $xs_available ? 2 : 1;
+
+plan tests => $tests_per_case * @cases;
+
+for my $case (@cases) {
+ run_case($case, $xs_available ? 'XS' : 'PP');
+ if ($xs_available) {
+ local $Data::Dumper::Useperl = 1;
+ run_case($case, 'PP');
+ }
+}
+
+sub run_case {
+ my ($case, $mode) = @_;
+ my ($input, $output, $desc, $conf) = @$case{qw<input output desc conf>};
+ my $obj = Data::Dumper->new([$input]);
+ $obj->Trailingcomma(1); # default to on for these tests
+ $obj->Sortkeys(1);
+ for my $k (sort keys %{ $conf || {} }) {
+ $obj->$k($conf->{$k});
+ }
+ chomp(my $got = _dumptostr($obj));
+ is($got, "\$VAR1 = $output;", "$desc (in $mode mode)");
+}

26
perl-Data-Dumper.spec
View File

@ -1,20 +1,19 @@
%global base_version 2.154
Name: perl-Data-Dumper
Version: 2.160
Release: 366%{?dist}
Version: 2.161
Release: 1%{?dist}
Summary: Stringify perl data structures, suitable for printing and eval
License: GPL+ or Artistic
Group: Development/Libraries
URL: http://search.cpan.org/dist/Data-Dumper/
Source0: http://www.cpan.org/authors/id/S/SM/SMUELLER/Data-Dumper-%{base_version}.tar.gz
# Unbundled from perl 5.21.11
Patch0: Data-Dumper-2.154-Upgrade-to-2.158.patch
# Unbundled from perl 5.24.0
Patch1: Data-Dumper-2.158-Upgrade-to-2.160.patch
Source0: http://www.cpan.org/authors/id/S/SM/SMUELLER/Data-Dumper-%{version}.tar.gz
BuildRequires: findutils
BuildRequires: gcc
BuildRequires: make
BuildRequires: perl
BuildRequires: perl-devel
BuildRequires: perl-generators
BuildRequires: perl(ExtUtils::MakeMaker)
BuildRequires: sed
# Run-time:
BuildRequires: perl(B::Deparse)
BuildRequires: perl(bytes)
@ -52,9 +51,7 @@ variable is output in a single Perl statement. Handles self-referential
structures correctly.
%prep
%setup -q -n Data-Dumper-%{base_version}
%patch0 -p1
%patch1 -p1
%setup -q -n Data-Dumper-%{version}
sed -i '/MAN3PODS/d' Makefile.PL
%build
@ -63,8 +60,8 @@ make %{?_smp_mflags}
%install
make pure_install DESTDIR=$RPM_BUILD_ROOT
find $RPM_BUILD_ROOT -type f -name .packlist -exec rm -f {} \;
find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -exec rm -f {} \;
find $RPM_BUILD_ROOT -type f -name .packlist -delete
find $RPM_BUILD_ROOT -type f -name '*.bs' -size 0 -delete
%{_fixperms} $RPM_BUILD_ROOT/*
%check
@ -79,6 +76,9 @@ make test
%{_mandir}/man3/*
%changelog
* 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

2
sources
View File

@ -1 +1 @@
577b4d4e53d7609457d36d674b6169a7 Data-Dumper-2.154.tar.gz
0c18654f06366c494d5c72801eab9393 Data-Dumper-2.161.tar.gz