1.161 bump
This commit is contained in:
parent
8bf1d0b68e
commit
01499c2b7c
1
.gitignore
vendored
1
.gitignore
vendored
@ -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
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -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)");
|
||||
+}
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user