From ecb5f56404cd6feb7e641913a7cae5de1b6054b3 Mon Sep 17 00:00:00 2001 From: Jitka Plesnikova <jples...@redhat.com> Date: Wed, 11 May 2016 15:22:00 +0200 Subject: 2.160 bump in order to dual-live with perl 5.24
--- Data-Dumper-2.158-Upgrade-to-2.160.patch | 929 +++++++++++++++++++++++++++++++ perl-Data-Dumper.spec | 12 +- 2 files changed, 939 insertions(+), 2 deletions(-) create mode 100644 Data-Dumper-2.158-Upgrade-to-2.160.patch diff --git a/Data-Dumper-2.158-Upgrade-to-2.160.patch b/Data-Dumper-2.158-Upgrade-to-2.160.patch new file mode 100644 index 0000000..45a6e52 --- /dev/null +++ b/Data-Dumper-2.158-Upgrade-to-2.160.patch @@ -0,0 +1,929 @@ +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)"); ++} diff --git a/perl-Data-Dumper.spec b/perl-Data-Dumper.spec index 4574f1f..88d1698 100644 --- a/perl-Data-Dumper.spec +++ b/perl-Data-Dumper.spec @@ -1,7 +1,7 @@ %global base_version 2.154 Name: perl-Data-Dumper -Version: 2.158 -Release: 348%{?dist} +Version: 2.160 +Release: 1%{?dist} Summary: Stringify perl data structures, suitable for printing and eval License: GPL+ or Artistic Group: Development/Libraries @@ -9,7 +9,11 @@ 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 BuildRequires: perl +BuildRequires: perl-devel +BuildRequires: perl-generators BuildRequires: perl(ExtUtils::MakeMaker) # Run-time: BuildRequires: perl(B::Deparse) @@ -50,6 +54,7 @@ structures correctly. %prep %setup -q -n Data-Dumper-%{base_version} %patch0 -p1 +%patch1 -p1 sed -i '/MAN3PODS/d' Makefile.PL %build @@ -74,6 +79,9 @@ make test %{_mandir}/man3/* %changelog +* Wed May 11 2016 Jitka Plesnikova <jples...@redhat.com> - 2.160-1 +- 2.160 bump in order to dual-live with perl 5.24 + * Thu Feb 04 2016 Fedora Release Engineering <rel...@fedoraproject.org> - 2.158-348 - Rebuilt for https://fedoraproject.org/wiki/Fedora_24_Mass_Rebuild -- cgit v0.12 http://pkgs.fedoraproject.org/cgit/perl-Data-Dumper.git/commit/?h=master&id=ecb5f56404cd6feb7e641913a7cae5de1b6054b3 -- Fedora Extras Perl SIG http://www.fedoraproject.org/wiki/Extras/SIGs/Perl perl-devel mailing list perl-devel@lists.fedoraproject.org http://lists.fedoraproject.org/admin/lists/perl-devel@lists.fedoraproject.org