Compare commits
No commits in common. 'i8c-stream-5.24' and 'c9' have entirely different histories.
i8c-stream
...
c9
@ -1 +1 @@
|
|||||||
SOURCES/Data-Dumper-2.161.tar.gz
|
SOURCES/Data-Dumper-2.173.tar.gz
|
||||||
|
|||||||
@ -1 +1 @@
|
|||||||
a20626bd76d293147dd8ff8afa88deafd2d26899 SOURCES/Data-Dumper-2.161.tar.gz
|
91ca53fd5499b913996009e763d73ebeb51be8c3 SOURCES/Data-Dumper-2.173.tar.gz
|
||||||
|
|||||||
@ -1,112 +0,0 @@
|
|||||||
From 76b7c82c2947d64a3494175ef6530b3fba8a499d Mon Sep 17 00:00:00 2001
|
|
||||||
From: Zefram <zefram@fysh.org>
|
|
||||||
Date: Wed, 10 Jan 2018 21:09:45 +0000
|
|
||||||
Subject: [PATCH] fix Data-Dumper postentry for quoted glob
|
|
||||||
MIME-Version: 1.0
|
|
||||||
Content-Type: text/plain; charset=UTF-8
|
|
||||||
Content-Transfer-Encoding: 8bit
|
|
||||||
|
|
||||||
In Data-Dumper, where a glob with a quoted name required a postentry,
|
|
||||||
the name part of the postentry was being emitted as just "}". This was
|
|
||||||
an old bug affecting upgraded glob names, which the recent commit
|
|
||||||
abda9fe0fe75ae824723761c1c98af958f17a41c made affect all quoted glob
|
|
||||||
names. Fix the postentry name to encompass the entire quoted name.
|
|
||||||
Fixes [perl #132695].
|
|
||||||
|
|
||||||
Petr Písař: Ported to Data-Dumpe-2.167 from perl
|
|
||||||
fb5043174b070927d312677f0a2f04a29b11349a.
|
|
||||||
|
|
||||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
||||||
---
|
|
||||||
Dumper.xs | 11 ++++++-----
|
|
||||||
t/dumper.t | 32 +++++++++++++++++++++++++++++++-
|
|
||||||
2 files changed, 37 insertions(+), 6 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/Dumper.xs b/Dumper.xs
|
|
||||||
index 8a16e04..206e8b5 100644
|
|
||||||
--- a/Dumper.xs
|
|
||||||
+++ b/Dumper.xs
|
|
||||||
@@ -1300,11 +1300,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
|
||||||
i = 0; else i -= 4;
|
|
||||||
}
|
|
||||||
if (globname_needs_quote(c,i)) {
|
|
||||||
- sv_grow(retval, SvCUR(retval)+2);
|
|
||||||
+ sv_grow(retval, SvCUR(retval)+3);
|
|
||||||
r = SvPVX(retval)+SvCUR(retval);
|
|
||||||
- r[0] = '*'; r[1] = '{';
|
|
||||||
+ r[0] = '*'; r[1] = '{'; r[2] = 0;
|
|
||||||
SvCUR_set(retval, SvCUR(retval)+2);
|
|
||||||
- esc_q_utf8(aTHX_ retval, c, i,
|
|
||||||
+ i = 3 + esc_q_utf8(aTHX_ retval, c, i,
|
|
||||||
#ifdef GvNAMEUTF8
|
|
||||||
!!GvNAMEUTF8(val)
|
|
||||||
#else
|
|
||||||
@@ -1314,15 +1314,16 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
|
||||||
sv_grow(retval, SvCUR(retval)+2);
|
|
||||||
r = SvPVX(retval)+SvCUR(retval);
|
|
||||||
r[0] = '}'; r[1] = '\0';
|
|
||||||
- i = 1;
|
|
||||||
+ SvCUR_set(retval, SvCUR(retval)+1);
|
|
||||||
+ r = r+1 - i;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
sv_grow(retval, SvCUR(retval)+i+2);
|
|
||||||
r = SvPVX(retval)+SvCUR(retval);
|
|
||||||
r[0] = '*'; strcpy(r+1, c);
|
|
||||||
i++;
|
|
||||||
+ SvCUR_set(retval, SvCUR(retval)+i);
|
|
||||||
}
|
|
||||||
- SvCUR_set(retval, SvCUR(retval)+i);
|
|
||||||
|
|
||||||
if (style->purity) {
|
|
||||||
static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
|
|
||||||
diff --git a/t/dumper.t b/t/dumper.t
|
|
||||||
index 0c12f34..e09a2dd 100644
|
|
||||||
--- a/t/dumper.t
|
|
||||||
+++ b/t/dumper.t
|
|
||||||
@@ -108,7 +108,7 @@ sub SKIP_TEST {
|
|
||||||
++$TNUM; print "ok $TNUM # skip $reason\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
-$TMAX = 456;
|
|
||||||
+$TMAX = 468;
|
|
||||||
|
|
||||||
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
|
|
||||||
# it direct. Out here it lets us knobble the next if to test that the perl
|
|
||||||
@@ -1773,3 +1773,33 @@ EOT
|
|
||||||
TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
|
|
||||||
if $XS;
|
|
||||||
}
|
|
||||||
+#############
|
|
||||||
+$WANT = <<'EOT';
|
|
||||||
+#$v = {
|
|
||||||
+# a => \*::ppp,
|
|
||||||
+# b => \*{'::a/b'},
|
|
||||||
+# c => \*{"::a\x{2603}b"}
|
|
||||||
+#};
|
|
||||||
+#*::ppp = {
|
|
||||||
+# a => 1
|
|
||||||
+#};
|
|
||||||
+#*{'::a/b'} = {
|
|
||||||
+# b => 3
|
|
||||||
+#};
|
|
||||||
+#*{"::a\x{2603}b"} = {
|
|
||||||
+# c => 5
|
|
||||||
+#};
|
|
||||||
+EOT
|
|
||||||
+{
|
|
||||||
+ *ppp = { a => 1 };
|
|
||||||
+ *{"a/b"} = { b => 3 };
|
|
||||||
+ *{"a\x{2603}b"} = { c => 5 };
|
|
||||||
+ our $v = { a => \*ppp, b => \*{"a/b"}, c => \*{"a\x{2603}b"} };
|
|
||||||
+ local $Data::Dumper::Purity = 1;
|
|
||||||
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
|
|
||||||
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
|
|
||||||
+ $WANT =~ tr/'/"/;
|
|
||||||
+ local $Data::Dumper::Useqq = 1;
|
|
||||||
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
|
|
||||||
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
|
|
||||||
+}
|
|
||||||
--
|
|
||||||
2.13.6
|
|
||||||
|
|
||||||
@ -1,134 +0,0 @@
|
|||||||
From 69beb4272d324bb0724b140b5ddca517e90d89b9 Mon Sep 17 00:00:00 2001
|
|
||||||
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
|
||||||
Date: Tue, 5 Dec 2017 10:59:42 +0100
|
|
||||||
Subject: [PATCH] in Data-Dumper, quote glob names better
|
|
||||||
MIME-Version: 1.0
|
|
||||||
Content-Type: text/plain; charset=UTF-8
|
|
||||||
Content-Transfer-Encoding: 8bit
|
|
||||||
|
|
||||||
Ported to Data-Dumper-1.167 from perl git tree:
|
|
||||||
|
|
||||||
commit abda9fe0fe75ae824723761c1c98af958f17a41c
|
|
||||||
Author: Zefram <zefram@fysh.org>
|
|
||||||
Date: Fri Dec 1 17:35:35 2017 +0000
|
|
||||||
|
|
||||||
in Data-Dumper, quote glob names better
|
|
||||||
|
|
||||||
Glob name quoting should obey Useqq. Fixes [perl #119831].
|
|
||||||
|
|
||||||
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
||||||
---
|
|
||||||
Dumper.pm | 4 ++--
|
|
||||||
Dumper.xs | 22 +++++++---------------
|
|
||||||
t/dumper.t | 35 ++++++++++++++++++++++++++++++++++-
|
|
||||||
3 files changed, 43 insertions(+), 18 deletions(-)
|
|
||||||
|
|
||||||
diff --git a/Dumper.pm b/Dumper.pm
|
|
||||||
index 00f6326..696964a 100644
|
|
||||||
--- a/Dumper.pm
|
|
||||||
+++ b/Dumper.pm
|
|
||||||
@@ -527,8 +527,8 @@ sub _dump {
|
|
||||||
$ref = \$val;
|
|
||||||
if (ref($ref) eq 'GLOB') { # glob
|
|
||||||
my $name = substr($val, 1);
|
|
||||||
- if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
|
|
||||||
- $name =~ s/^main::/::/;
|
|
||||||
+ $name =~ s/^main::(?!\z)/::/;
|
|
||||||
+ if ($name =~ /\A(?:[A-Z_a-z][0-9A-Z_a-z]*)?::(?:[0-9A-Z_a-z]+::)*[0-9A-Z_a-z]*\z/ && $name ne 'main::') {
|
|
||||||
$sname = $name;
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
diff --git a/Dumper.xs b/Dumper.xs
|
|
||||||
index 5a21721..8a16e04 100644
|
|
||||||
--- a/Dumper.xs
|
|
||||||
+++ b/Dumper.xs
|
|
||||||
@@ -1300,29 +1300,21 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
|
||||||
i = 0; else i -= 4;
|
|
||||||
}
|
|
||||||
if (globname_needs_quote(c,i)) {
|
|
||||||
-#ifdef GvNAMEUTF8
|
|
||||||
- if (GvNAMEUTF8(val)) {
|
|
||||||
sv_grow(retval, SvCUR(retval)+2);
|
|
||||||
r = SvPVX(retval)+SvCUR(retval);
|
|
||||||
r[0] = '*'; r[1] = '{';
|
|
||||||
SvCUR_set(retval, SvCUR(retval)+2);
|
|
||||||
- esc_q_utf8(aTHX_ retval, c, i, 1, style->useqq);
|
|
||||||
+ esc_q_utf8(aTHX_ retval, c, i,
|
|
||||||
+#ifdef GvNAMEUTF8
|
|
||||||
+ !!GvNAMEUTF8(val)
|
|
||||||
+#else
|
|
||||||
+ 0
|
|
||||||
+#endif
|
|
||||||
+ , style->useqq);
|
|
||||||
sv_grow(retval, SvCUR(retval)+2);
|
|
||||||
r = SvPVX(retval)+SvCUR(retval);
|
|
||||||
r[0] = '}'; r[1] = '\0';
|
|
||||||
i = 1;
|
|
||||||
- }
|
|
||||||
- else
|
|
||||||
-#endif
|
|
||||||
- {
|
|
||||||
- sv_grow(retval, SvCUR(retval)+6+2*i);
|
|
||||||
- r = SvPVX(retval)+SvCUR(retval);
|
|
||||||
- r[0] = '*'; r[1] = '{'; r[2] = '\'';
|
|
||||||
- i += esc_q(r+3, c, i);
|
|
||||||
- i += 3;
|
|
||||||
- r[i++] = '\''; r[i++] = '}';
|
|
||||||
- r[i] = '\0';
|
|
||||||
- }
|
|
||||||
}
|
|
||||||
else {
|
|
||||||
sv_grow(retval, SvCUR(retval)+i+2);
|
|
||||||
diff --git a/t/dumper.t b/t/dumper.t
|
|
||||||
index 643160a..0c12f34 100644
|
|
||||||
--- a/t/dumper.t
|
|
||||||
+++ b/t/dumper.t
|
|
||||||
@@ -108,7 +108,7 @@ sub SKIP_TEST {
|
|
||||||
++$TNUM; print "ok $TNUM # skip $reason\n";
|
|
||||||
}
|
|
||||||
|
|
||||||
-$TMAX = 450;
|
|
||||||
+$TMAX = 456;
|
|
||||||
|
|
||||||
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
|
|
||||||
# it direct. Out here it lets us knobble the next if to test that the perl
|
|
||||||
@@ -1740,3 +1740,36 @@ EOT
|
|
||||||
TEST (qq(Dumper("\n")), '\n alone');
|
|
||||||
TEST (qq(Data::Dumper::DumperX("\n")), '\n alone') if $XS;
|
|
||||||
}
|
|
||||||
+#############
|
|
||||||
+our @globs = map { $_, \$_ } map { *$_ } map { $_, "s::$_" }
|
|
||||||
+ "foo", "\1bar", "L\x{e9}on", "m\x{100}cron", "snow\x{2603}";
|
|
||||||
+$WANT = <<'EOT';
|
|
||||||
+#$globs = [
|
|
||||||
+# *::foo,
|
|
||||||
+# \*::foo,
|
|
||||||
+# *s::foo,
|
|
||||||
+# \*s::foo,
|
|
||||||
+# *{"::\1bar"},
|
|
||||||
+# \*{"::\1bar"},
|
|
||||||
+# *{"s::\1bar"},
|
|
||||||
+# \*{"s::\1bar"},
|
|
||||||
+# *{"::L\351on"},
|
|
||||||
+# \*{"::L\351on"},
|
|
||||||
+# *{"s::L\351on"},
|
|
||||||
+# \*{"s::L\351on"},
|
|
||||||
+# *{"::m\x{100}cron"},
|
|
||||||
+# \*{"::m\x{100}cron"},
|
|
||||||
+# *{"s::m\x{100}cron"},
|
|
||||||
+# \*{"s::m\x{100}cron"},
|
|
||||||
+# *{"::snow\x{2603}"},
|
|
||||||
+# \*{"::snow\x{2603}"},
|
|
||||||
+# *{"s::snow\x{2603}"},
|
|
||||||
+# \*{"s::snow\x{2603}"}
|
|
||||||
+#];
|
|
||||||
+EOT
|
|
||||||
+{
|
|
||||||
+ local $Data::Dumper::Useqq = 1;
|
|
||||||
+ TEST (q(Data::Dumper->Dump([\@globs], ["globs"])), 'globs: Dump()');
|
|
||||||
+ TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
|
|
||||||
+ if $XS;
|
|
||||||
+}
|
|
||||||
--
|
|
||||||
2.13.6
|
|
||||||
|
|
||||||
@ -0,0 +1,243 @@
|
|||||||
|
From 900c00b2ae29aa10b5cf0b3b5c55aff7501fc382 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Wed, 12 Aug 2020 16:20:16 +1000
|
||||||
|
Subject: [PATCH 3/3] Data::Dumper (XS): use mortals to prevent leaks if magic
|
||||||
|
throws
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
For example:
|
||||||
|
|
||||||
|
use Tie::Scalar;
|
||||||
|
use Data::Dumper;
|
||||||
|
sub T::TIESCALAR { bless {}, shift}
|
||||||
|
sub T::FETCH { die }
|
||||||
|
my $x;
|
||||||
|
tie $x, "T" or die;
|
||||||
|
while(1) {
|
||||||
|
eval { () = Dumper( [ \$x ] ) };
|
||||||
|
}
|
||||||
|
|
||||||
|
would leak various work SVs.
|
||||||
|
|
||||||
|
I start a new scope (ENTER/LEAVE) for most recursive DD_dump() calls
|
||||||
|
so that the work SVs don't accumulate on the temps stack, for example
|
||||||
|
if we're dumping a large array we'd end up with several SVs on the
|
||||||
|
temp stack for each member of the array.
|
||||||
|
|
||||||
|
The exceptions are where I don't expect a large number of unreleased
|
||||||
|
temps to accumulate, as with scalar or glob refs.
|
||||||
|
|
||||||
|
Petr Písař: Ported to Data-Dumper-2.173 from
|
||||||
|
815b4be4ab7ae210f796fc9d29754e55fc0d1f0e perl commit.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
Dumper.xs | 52 ++++++++++++++++++++++++++++------------------------
|
||||||
|
1 file changed, 28 insertions(+), 24 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/Dumper.xs b/Dumper.xs
|
||||||
|
index d4b34ad..65639ae 100644
|
||||||
|
--- a/Dumper.xs
|
||||||
|
+++ b/Dumper.xs
|
||||||
|
@@ -808,12 +808,13 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
sv_catpvs(retval, "( ");
|
||||||
|
if (style->indent >= 2) {
|
||||||
|
blesspad = apad;
|
||||||
|
- apad = newSVsv(apad);
|
||||||
|
+ apad = sv_2mortal(newSVsv(apad));
|
||||||
|
sv_x(aTHX_ apad, " ", 1, blesslen+2);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
ipad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad), SvCUR(style->xpad), level+1);
|
||||||
|
+ sv_2mortal(ipad);
|
||||||
|
|
||||||
|
if (is_regex)
|
||||||
|
{
|
||||||
|
@@ -878,7 +879,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
realtype <= SVt_PVMG
|
||||||
|
#endif
|
||||||
|
) { /* scalar ref */
|
||||||
|
- SV * const namesv = newSVpvs("${");
|
||||||
|
+ SV * const namesv = sv_2mortal(newSVpvs("${"));
|
||||||
|
sv_catpvn(namesv, name, namelen);
|
||||||
|
sv_catpvs(namesv, "}");
|
||||||
|
if (realpack) { /* blessed */
|
||||||
|
@@ -892,7 +893,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
DD_dump(aTHX_ ival, SvPVX_const(namesv), SvCUR(namesv), retval, seenhv,
|
||||||
|
postav, level+1, apad, style);
|
||||||
|
}
|
||||||
|
- SvREFCNT_dec(namesv);
|
||||||
|
}
|
||||||
|
else if (realtype == SVt_PVGV) { /* glob ref */
|
||||||
|
SV * const namesv = newSVpvs("*{");
|
||||||
|
@@ -908,9 +908,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
SSize_t ix = 0;
|
||||||
|
const SSize_t ixmax = av_len((AV *)ival);
|
||||||
|
|
||||||
|
- SV * const ixsv = newSViv(0);
|
||||||
|
+ SV * const ixsv = sv_2mortal(newSViv(0));
|
||||||
|
/* allowing for a 24 char wide array index */
|
||||||
|
New(0, iname, namelen+28, char);
|
||||||
|
+ SAVEFREEPV(iname);
|
||||||
|
(void) strlcpy(iname, name, namelen+28);
|
||||||
|
inamelen = namelen;
|
||||||
|
if (name[0] == '@') {
|
||||||
|
@@ -940,7 +941,7 @@ 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(style->sep);
|
||||||
|
+ totpad = sv_2mortal(newSVsv(style->sep));
|
||||||
|
sv_catsv(totpad, style->pad);
|
||||||
|
sv_catsv(totpad, apad);
|
||||||
|
|
||||||
|
@@ -970,8 +971,12 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
}
|
||||||
|
sv_catsv(retval, totpad);
|
||||||
|
sv_catsv(retval, ipad);
|
||||||
|
+ ENTER;
|
||||||
|
+ SAVETMPS;
|
||||||
|
DD_dump(aTHX_ elem, iname, ilen, retval, seenhv, postav,
|
||||||
|
level+1, apad, style);
|
||||||
|
+ FREETMPS;
|
||||||
|
+ LEAVE;
|
||||||
|
if (ix < ixmax || (style->trailingcomma && style->indent >= 1))
|
||||||
|
sv_catpvs(retval, ",");
|
||||||
|
}
|
||||||
|
@@ -985,9 +990,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
sv_catpvs(retval, ")");
|
||||||
|
else
|
||||||
|
sv_catpvs(retval, "]");
|
||||||
|
- SvREFCNT_dec(ixsv);
|
||||||
|
- SvREFCNT_dec(totpad);
|
||||||
|
- Safefree(iname);
|
||||||
|
}
|
||||||
|
else if (realtype == SVt_PVHV) {
|
||||||
|
SV *totpad, *newapad;
|
||||||
|
@@ -997,7 +999,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
SV *hval;
|
||||||
|
AV *keys = NULL;
|
||||||
|
|
||||||
|
- SV * const iname = newSVpvn(name, namelen);
|
||||||
|
+ SV * const iname = newSVpvn_flags(name, namelen, SVs_TEMP);
|
||||||
|
if (name[0] == '%') {
|
||||||
|
sv_catpvs(retval, "(");
|
||||||
|
(SvPVX(iname))[0] = '$';
|
||||||
|
@@ -1021,7 +1023,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
sv_catpvs(iname, "->");
|
||||||
|
}
|
||||||
|
sv_catpvs(iname, "{");
|
||||||
|
- totpad = newSVsv(style->sep);
|
||||||
|
+ totpad = sv_2mortal(newSVsv(style->sep));
|
||||||
|
sv_catsv(totpad, style->pad);
|
||||||
|
sv_catsv(totpad, apad);
|
||||||
|
|
||||||
|
@@ -1117,6 +1119,10 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
|
||||||
|
sv_catsv(retval, totpad);
|
||||||
|
sv_catsv(retval, ipad);
|
||||||
|
+
|
||||||
|
+ ENTER;
|
||||||
|
+ SAVETMPS;
|
||||||
|
+
|
||||||
|
/* The (very)
|
||||||
|
old logic was first to check utf8 flag, and if utf8 always
|
||||||
|
call esc_q_utf8. This caused test to break under -Mutf8,
|
||||||
|
@@ -1143,6 +1149,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
else {
|
||||||
|
nticks = num_q(key, klen);
|
||||||
|
New(0, nkey_buffer, klen+nticks+3, char);
|
||||||
|
+ SAVEFREEPV(nkey_buffer);
|
||||||
|
nkey = nkey_buffer;
|
||||||
|
nkey[0] = '\'';
|
||||||
|
if (nticks)
|
||||||
|
@@ -1160,7 +1167,8 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
nlen = klen;
|
||||||
|
sv_catpvn(retval, nkey, klen);
|
||||||
|
}
|
||||||
|
- sname = newSVsv(iname);
|
||||||
|
+
|
||||||
|
+ sname = sv_2mortal(newSVsv(iname));
|
||||||
|
sv_catpvn(sname, nkey, nlen);
|
||||||
|
sv_catpvs(sname, "}");
|
||||||
|
|
||||||
|
@@ -1168,7 +1176,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
if (style->indent >= 2) {
|
||||||
|
char *extra;
|
||||||
|
STRLEN elen = 0;
|
||||||
|
- newapad = newSVsv(apad);
|
||||||
|
+ newapad = sv_2mortal(newSVsv(apad));
|
||||||
|
New(0, extra, klen+4+1, char);
|
||||||
|
while (elen < (klen+4))
|
||||||
|
extra[elen++] = ' ';
|
||||||
|
@@ -1181,10 +1189,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
|
||||||
|
DD_dump(aTHX_ hval, SvPVX_const(sname), SvCUR(sname), retval, seenhv,
|
||||||
|
postav, level+1, newapad, style);
|
||||||
|
- SvREFCNT_dec(sname);
|
||||||
|
- Safefree(nkey_buffer);
|
||||||
|
- if (style->indent >= 2)
|
||||||
|
- SvREFCNT_dec(newapad);
|
||||||
|
+
|
||||||
|
+ FREETMPS;
|
||||||
|
+ LEAVE;
|
||||||
|
}
|
||||||
|
if (i) {
|
||||||
|
SV *opad = sv_x(aTHX_ Nullsv, SvPVX_const(style->xpad),
|
||||||
|
@@ -1199,8 +1206,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
sv_catpvs(retval, ")");
|
||||||
|
else
|
||||||
|
sv_catpvs(retval, "}");
|
||||||
|
- SvREFCNT_dec(iname);
|
||||||
|
- SvREFCNT_dec(totpad);
|
||||||
|
}
|
||||||
|
else if (realtype == SVt_PVCV) {
|
||||||
|
if (style->deparse) {
|
||||||
|
@@ -1247,7 +1252,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
STRLEN plen, pticks;
|
||||||
|
|
||||||
|
if (style->indent >= 2) {
|
||||||
|
- SvREFCNT_dec(apad);
|
||||||
|
apad = blesspad;
|
||||||
|
}
|
||||||
|
sv_catpvs(retval, ", '");
|
||||||
|
@@ -1276,7 +1280,6 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
sv_catpvs(retval, "()");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
- SvREFCNT_dec(ipad);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
STRLEN i;
|
||||||
|
@@ -1671,20 +1674,21 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
|
||||||
|
if (style.indent >= 2 && !terse) {
|
||||||
|
SV * const tmpsv = sv_x(aTHX_ NULL, " ", 1, SvCUR(name)+3);
|
||||||
|
- newapad = newSVsv(apad);
|
||||||
|
+ newapad = sv_2mortal(newSVsv(apad));
|
||||||
|
sv_catsv(newapad, tmpsv);
|
||||||
|
SvREFCNT_dec(tmpsv);
|
||||||
|
}
|
||||||
|
else
|
||||||
|
newapad = apad;
|
||||||
|
|
||||||
|
+ ENTER;
|
||||||
|
+ SAVETMPS;
|
||||||
|
PUTBACK;
|
||||||
|
DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
|
||||||
|
postav, 0, newapad, &style);
|
||||||
|
SPAGAIN;
|
||||||
|
-
|
||||||
|
- if (style.indent >= 2 && !terse)
|
||||||
|
- SvREFCNT_dec(newapad);
|
||||||
|
+ FREETMPS;
|
||||||
|
+ LEAVE;
|
||||||
|
|
||||||
|
postlen = av_len(postav);
|
||||||
|
if (postlen >= 0 || !terse) {
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
||||||
@ -0,0 +1,167 @@
|
|||||||
|
From d9c4b4ae5a1a17347ff5e3ecbf8e1d9da481f476 Mon Sep 17 00:00:00 2001
|
||||||
|
From: David Mitchell <davem@iabyn.com>
|
||||||
|
Date: Wed, 3 Apr 2019 13:23:24 +0100
|
||||||
|
Subject: [PATCH] Data::Dumper - avoid leak on croak
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
v5.21.3-742-g19be3be696 added a facility to Dumper.xs to croak if the
|
||||||
|
recursion level became too deep (1000 by default).
|
||||||
|
|
||||||
|
The trouble with this is that various parts of DD_dump() allocate
|
||||||
|
temporary SVs and buffers, which will leak if DD_dump() unceremoniously
|
||||||
|
just croaks().
|
||||||
|
|
||||||
|
This currently manifests as dist/Data-Dumper/t/recurse.t failing under
|
||||||
|
Address Sanitiser.
|
||||||
|
|
||||||
|
This commit makes the depth checking code just set a sticky 'too deep'
|
||||||
|
boolean flag, and
|
||||||
|
a) on entry, DD_dump() just returns immediately if the flag is set;
|
||||||
|
b) the flag is checked by the top-level called of DD_dump() and croaks
|
||||||
|
if set.
|
||||||
|
|
||||||
|
So the net effect is to defer croaking until the dump is complete,
|
||||||
|
and avoid any further recursion once the flag is set.
|
||||||
|
|
||||||
|
This is a bit of a quick fix. More long-term solutions would be to
|
||||||
|
convert DD_dump() to be iterative rather than recursive, and/or make
|
||||||
|
sure all temporary SVs and buffers are suitably anchored somewhere so
|
||||||
|
that they get cleaned up on croak.
|
||||||
|
|
||||||
|
Petr Písař: Ported from 6d65cb5d847ac93680949c4fa02111808207fbdc in
|
||||||
|
perl git tree.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
Dumper.pm | 6 +++---
|
||||||
|
Dumper.xs | 27 ++++++++++++++++++++-------
|
||||||
|
2 files changed, 23 insertions(+), 10 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/Dumper.pm b/Dumper.pm
|
||||||
|
index 40aeb7d..06af4c4 100644
|
||||||
|
--- a/Dumper.pm
|
||||||
|
+++ b/Dumper.pm
|
||||||
|
@@ -10,7 +10,7 @@
|
||||||
|
package Data::Dumper;
|
||||||
|
|
||||||
|
BEGIN {
|
||||||
|
- $VERSION = '2.173'; # Don't forget to set version and release
|
||||||
|
+ $VERSION = '2.174'; # Don't forget to set version and release
|
||||||
|
} # date in POD below!
|
||||||
|
|
||||||
|
#$| = 1;
|
||||||
|
@@ -1461,13 +1461,13 @@ be to use the C<Sortkeys> filter of Data::Dumper.
|
||||||
|
|
||||||
|
Gurusamy Sarathy gsar@activestate.com
|
||||||
|
|
||||||
|
-Copyright (c) 1996-2017 Gurusamy Sarathy. All rights reserved.
|
||||||
|
+Copyright (c) 1996-2019 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.173
|
||||||
|
+Version 2.174
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
diff --git a/Dumper.xs b/Dumper.xs
|
||||||
|
index 7f0b027..a324cb6 100644
|
||||||
|
--- a/Dumper.xs
|
||||||
|
+++ b/Dumper.xs
|
||||||
|
@@ -61,9 +61,10 @@
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* 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). */
|
||||||
|
+ * is treated as mostly constant (except for maxrecursed) 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;
|
||||||
|
@@ -74,6 +75,7 @@ typedef struct {
|
||||||
|
SV *toaster;
|
||||||
|
SV *bless;
|
||||||
|
IV maxrecurse;
|
||||||
|
+ bool maxrecursed; /* at some point we exceeded the maximum recursion level */
|
||||||
|
I32 indent;
|
||||||
|
I32 purity;
|
||||||
|
I32 deepcopy;
|
||||||
|
@@ -97,7 +99,7 @@ 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, const I32 level, SV *apad,
|
||||||
|
- const Style *style);
|
||||||
|
+ Style *style);
|
||||||
|
|
||||||
|
#ifndef HvNAME_get
|
||||||
|
#define HvNAME_get HvNAME
|
||||||
|
@@ -615,7 +617,7 @@ deparsed_output(pTHX_ SV *val)
|
||||||
|
*/
|
||||||
|
static I32
|
||||||
|
DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
- AV *postav, const I32 level, SV *apad, const Style *style)
|
||||||
|
+ AV *postav, const I32 level, SV *apad, Style *style)
|
||||||
|
{
|
||||||
|
char tmpbuf[128];
|
||||||
|
Size_t i;
|
||||||
|
@@ -642,6 +644,9 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
if (!val)
|
||||||
|
return 0;
|
||||||
|
|
||||||
|
+ if (style->maxrecursed)
|
||||||
|
+ return 0;
|
||||||
|
+
|
||||||
|
/* If the output buffer has less than some arbitrary amount of space
|
||||||
|
remaining, then enlarge it. For the test case (25M of output),
|
||||||
|
*1.1 was slower, *2.0 was the same, so the first guess of 1.5 is
|
||||||
|
@@ -793,7 +798,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
||||||
|
}
|
||||||
|
|
||||||
|
if (style->maxrecurse > 0 && level >= style->maxrecurse) {
|
||||||
|
- croak("Recursion limit of %" IVdf " exceeded", style->maxrecurse);
|
||||||
|
+ style->maxrecursed = TRUE;
|
||||||
|
}
|
||||||
|
|
||||||
|
if (realpack && !no_bless) { /* we have a blessed ref */
|
||||||
|
@@ -1528,6 +1533,7 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
style.indent = 2;
|
||||||
|
style.quotekeys = 1;
|
||||||
|
style.maxrecurse = 1000;
|
||||||
|
+ style.maxrecursed = FALSE;
|
||||||
|
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
|
||||||
|
@@ -1675,7 +1681,7 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
DD_dump(aTHX_ val, SvPVX_const(name), SvCUR(name), valstr, seenhv,
|
||||||
|
postav, 0, newapad, &style);
|
||||||
|
SPAGAIN;
|
||||||
|
-
|
||||||
|
+
|
||||||
|
if (style.indent >= 2 && !terse)
|
||||||
|
SvREFCNT_dec(newapad);
|
||||||
|
|
||||||
|
@@ -1715,6 +1721,13 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
}
|
||||||
|
SvREFCNT_dec(postav);
|
||||||
|
SvREFCNT_dec(valstr);
|
||||||
|
+
|
||||||
|
+ /* we defer croaking until here so that temporary SVs and
|
||||||
|
+ * buffers won't be leaked */
|
||||||
|
+ if (style.maxrecursed)
|
||||||
|
+ croak("Recursion limit of %" IVdf " exceeded",
|
||||||
|
+ style.maxrecurse);
|
||||||
|
+
|
||||||
|
}
|
||||||
|
else
|
||||||
|
croak("Call to new() method failed to return HASH ref");
|
||||||
|
--
|
||||||
|
2.20.1
|
||||||
|
|
||||||
@ -0,0 +1,56 @@
|
|||||||
|
From 65ec73b1bc79648a2daeb494552ce0b0b90348d7 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Mon, 10 Aug 2020 16:26:30 +1000
|
||||||
|
Subject: [PATCH 1/3] Data::Dumper: don't leak the working retval
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
do this by mortalizing the SV on creation, rather than when we
|
||||||
|
push it on the stack
|
||||||
|
|
||||||
|
Petr Písař: Ported to Data-Dumper-2.173 from
|
||||||
|
41463160be4baa0d81d9d8297508a1b9bdcaa206 perl commit.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
Dumper.xs | 8 ++++----
|
||||||
|
1 file changed, 4 insertions(+), 4 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/Dumper.xs b/Dumper.xs
|
||||||
|
index a324cb6..f91145a 100644
|
||||||
|
--- a/Dumper.xs
|
||||||
|
+++ b/Dumper.xs
|
||||||
|
@@ -1541,7 +1541,7 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
seenhv = NULL;
|
||||||
|
name = sv_newmortal();
|
||||||
|
|
||||||
|
- retval = newSVpvs("");
|
||||||
|
+ retval = newSVpvs_flags("", SVs_TEMP);
|
||||||
|
if (SvROK(href)
|
||||||
|
&& (hv = (HV*)SvRV((SV*)href))
|
||||||
|
&& SvTYPE(hv) == SVt_PVHV) {
|
||||||
|
@@ -1714,9 +1714,9 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
}
|
||||||
|
SvPVCLEAR(valstr);
|
||||||
|
if (gimme == G_ARRAY) {
|
||||||
|
- XPUSHs(sv_2mortal(retval));
|
||||||
|
+ XPUSHs(retval);
|
||||||
|
if (i < imax) /* not the last time thro ? */
|
||||||
|
- retval = newSVpvs("");
|
||||||
|
+ retval = newSVpvs_flags("", SVs_TEMP);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
SvREFCNT_dec(postav);
|
||||||
|
@@ -1732,7 +1732,7 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
else
|
||||||
|
croak("Call to new() method failed to return HASH ref");
|
||||||
|
if (gimme != G_ARRAY)
|
||||||
|
- XPUSHs(sv_2mortal(retval));
|
||||||
|
+ XPUSHs(retval);
|
||||||
|
}
|
||||||
|
|
||||||
|
SV *
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
||||||
@ -0,0 +1,53 @@
|
|||||||
|
From 21e67795792e5e1d25bcbd3b167ed18d0d6dc7b4 Mon Sep 17 00:00:00 2001
|
||||||
|
From: Tony Cook <tony@develop-help.com>
|
||||||
|
Date: Tue, 11 Aug 2020 10:46:38 +1000
|
||||||
|
Subject: [PATCH 2/3] make postav and valstr mortal so they're freed soonish
|
||||||
|
MIME-Version: 1.0
|
||||||
|
Content-Type: text/plain; charset=UTF-8
|
||||||
|
Content-Transfer-Encoding: 8bit
|
||||||
|
|
||||||
|
these can leak if the value being dumped (or any part of it)
|
||||||
|
had get magic and that magic throws an exception.
|
||||||
|
|
||||||
|
Several other SVs can also leak in that case, but cleaning those up
|
||||||
|
is more complex.
|
||||||
|
|
||||||
|
Petr Písař: Ported to Data-Dumper-2.173 from
|
||||||
|
b98a3a6d08f681353d0b357fd1cce437c93656e7 perl commit.
|
||||||
|
|
||||||
|
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
||||||
|
---
|
||||||
|
Dumper.xs | 5 ++---
|
||||||
|
1 file changed, 2 insertions(+), 3 deletions(-)
|
||||||
|
|
||||||
|
diff --git a/Dumper.xs b/Dumper.xs
|
||||||
|
index f91145a..d4b34ad 100644
|
||||||
|
--- a/Dumper.xs
|
||||||
|
+++ b/Dumper.xs
|
||||||
|
@@ -1613,12 +1613,13 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
style.sortkeys = &PL_sv_yes;
|
||||||
|
}
|
||||||
|
postav = newAV();
|
||||||
|
+ sv_2mortal((SV*)postav);
|
||||||
|
|
||||||
|
if (todumpav)
|
||||||
|
imax = av_len(todumpav);
|
||||||
|
else
|
||||||
|
imax = -1;
|
||||||
|
- valstr = newSVpvs("");
|
||||||
|
+ valstr = newSVpvs_flags("", SVs_TEMP);
|
||||||
|
for (i = 0; i <= imax; ++i) {
|
||||||
|
SV *newapad;
|
||||||
|
|
||||||
|
@@ -1719,8 +1720,6 @@ Data_Dumper_Dumpxs(href, ...)
|
||||||
|
retval = newSVpvs_flags("", SVs_TEMP);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
- SvREFCNT_dec(postav);
|
||||||
|
- SvREFCNT_dec(valstr);
|
||||||
|
|
||||||
|
/* we defer croaking until here so that temporary SVs and
|
||||||
|
* buffers won't be leaked */
|
||||||
|
--
|
||||||
|
2.25.4
|
||||||
|
|
||||||
Loading…
Reference in new issue