rpms
/
perl-Data-Dumper
20
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
Branches Tags
${ item.name }
Create tag ${ searchTerm }
Create branch ${ searchTerm }
from 'ccc0862728'
${ noResults }
perl-Data-Dumper/SOURCES/Data-Dumper-2.161-Upgrade-t...

635 lines
23 KiB
Raw Normal View History Unescape

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