|
 |
44064a |
From 76b7c82c2947d64a3494175ef6530b3fba8a499d Mon Sep 17 00:00:00 2001
|
|
|
44064a |
From: Zefram <zefram@fysh.org>
|
|
|
44064a |
Date: Wed, 10 Jan 2018 21:09:45 +0000
|
|
|
44064a |
Subject: [PATCH] fix Data-Dumper postentry for quoted glob
|
|
|
44064a |
MIME-Version: 1.0
|
|
|
44064a |
Content-Type: text/plain; charset=UTF-8
|
|
|
44064a |
Content-Transfer-Encoding: 8bit
|
|
|
44064a |
|
|
|
44064a |
In Data-Dumper, where a glob with a quoted name required a postentry,
|
|
|
44064a |
the name part of the postentry was being emitted as just "}". This was
|
|
|
44064a |
an old bug affecting upgraded glob names, which the recent commit
|
|
|
44064a |
abda9fe0fe75ae824723761c1c98af958f17a41c made affect all quoted glob
|
|
|
44064a |
names. Fix the postentry name to encompass the entire quoted name.
|
|
|
44064a |
Fixes [perl #132695].
|
|
|
44064a |
|
|
|
44064a |
Petr Písař: Ported to Data-Dumpe-2.167 from perl
|
|
|
44064a |
fb5043174b070927d312677f0a2f04a29b11349a.
|
|
|
44064a |
|
|
|
44064a |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
44064a |
---
|
|
|
44064a |
Dumper.xs | 11 ++++++-----
|
|
|
44064a |
t/dumper.t | 32 +++++++++++++++++++++++++++++++-
|
|
|
44064a |
2 files changed, 37 insertions(+), 6 deletions(-)
|
|
|
44064a |
|
|
|
44064a |
diff --git a/Dumper.xs b/Dumper.xs
|
|
|
44064a |
index 8a16e04..206e8b5 100644
|
|
|
44064a |
--- a/Dumper.xs
|
|
|
44064a |
+++ b/Dumper.xs
|
|
|
44064a |
@@ -1300,11 +1300,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
|
|
44064a |
i = 0; else i -= 4;
|
|
|
44064a |
}
|
|
|
44064a |
if (globname_needs_quote(c,i)) {
|
|
|
44064a |
- sv_grow(retval, SvCUR(retval)+2);
|
|
|
44064a |
+ sv_grow(retval, SvCUR(retval)+3);
|
|
|
44064a |
r = SvPVX(retval)+SvCUR(retval);
|
|
|
44064a |
- r[0] = '*'; r[1] = '{';
|
|
|
44064a |
+ r[0] = '*'; r[1] = '{'; r[2] = 0;
|
|
|
44064a |
SvCUR_set(retval, SvCUR(retval)+2);
|
|
|
44064a |
- esc_q_utf8(aTHX_ retval, c, i,
|
|
|
44064a |
+ i = 3 + esc_q_utf8(aTHX_ retval, c, i,
|
|
|
44064a |
#ifdef GvNAMEUTF8
|
|
|
44064a |
!!GvNAMEUTF8(val)
|
|
|
44064a |
#else
|
|
|
44064a |
@@ -1314,15 +1314,16 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
|
|
|
44064a |
sv_grow(retval, SvCUR(retval)+2);
|
|
|
44064a |
r = SvPVX(retval)+SvCUR(retval);
|
|
|
44064a |
r[0] = '}'; r[1] = '\0';
|
|
|
44064a |
- i = 1;
|
|
|
44064a |
+ SvCUR_set(retval, SvCUR(retval)+1);
|
|
|
44064a |
+ r = r+1 - i;
|
|
|
44064a |
}
|
|
|
44064a |
else {
|
|
|
44064a |
sv_grow(retval, SvCUR(retval)+i+2);
|
|
|
44064a |
r = SvPVX(retval)+SvCUR(retval);
|
|
|
44064a |
r[0] = '*'; strcpy(r+1, c);
|
|
|
44064a |
i++;
|
|
|
44064a |
+ SvCUR_set(retval, SvCUR(retval)+i);
|
|
|
44064a |
}
|
|
|
44064a |
- SvCUR_set(retval, SvCUR(retval)+i);
|
|
|
44064a |
|
|
|
44064a |
if (style->purity) {
|
|
|
44064a |
static const char* const entries[] = { "{SCALAR}", "{ARRAY}", "{HASH}" };
|
|
|
44064a |
diff --git a/t/dumper.t b/t/dumper.t
|
|
|
44064a |
index 0c12f34..e09a2dd 100644
|
|
|
44064a |
--- a/t/dumper.t
|
|
|
44064a |
+++ b/t/dumper.t
|
|
|
44064a |
@@ -108,7 +108,7 @@ sub SKIP_TEST {
|
|
|
44064a |
++$TNUM; print "ok $TNUM # skip $reason\n";
|
|
|
44064a |
}
|
|
|
44064a |
|
|
|
44064a |
-$TMAX = 456;
|
|
|
44064a |
+$TMAX = 468;
|
|
|
44064a |
|
|
|
44064a |
# Force Data::Dumper::Dump to use perl. We test Dumpxs explicitly by calling
|
|
|
44064a |
# it direct. Out here it lets us knobble the next if to test that the perl
|
|
|
44064a |
@@ -1773,3 +1773,33 @@ EOT
|
|
|
44064a |
TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
|
|
|
44064a |
if $XS;
|
|
|
44064a |
}
|
|
|
44064a |
+#############
|
|
|
44064a |
+$WANT = <<'EOT';
|
|
|
44064a |
+#$v = {
|
|
|
44064a |
+# a => \*::ppp,
|
|
|
44064a |
+# b => \*{'::a/b'},
|
|
|
44064a |
+# c => \*{"::a\x{2603}b"}
|
|
|
44064a |
+#};
|
|
|
44064a |
+#*::ppp = {
|
|
|
44064a |
+# a => 1
|
|
|
44064a |
+#};
|
|
|
44064a |
+#*{'::a/b'} = {
|
|
|
44064a |
+# b => 3
|
|
|
44064a |
+#};
|
|
|
44064a |
+#*{"::a\x{2603}b"} = {
|
|
|
44064a |
+# c => 5
|
|
|
44064a |
+#};
|
|
|
44064a |
+EOT
|
|
|
44064a |
+{
|
|
|
44064a |
+ *ppp = { a => 1 };
|
|
|
44064a |
+ *{"a/b"} = { b => 3 };
|
|
|
44064a |
+ *{"a\x{2603}b"} = { c => 5 };
|
|
|
44064a |
+ our $v = { a => \*ppp, b => \*{"a/b"}, c => \*{"a\x{2603}b"} };
|
|
|
44064a |
+ local $Data::Dumper::Purity = 1;
|
|
|
44064a |
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
|
|
|
44064a |
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
|
|
|
44064a |
+ $WANT =~ tr/'/"/;
|
|
|
44064a |
+ local $Data::Dumper::Useqq = 1;
|
|
|
44064a |
+ TEST (q(Data::Dumper->Dump([$v], ["v"])), 'glob purity: Dump()');
|
|
|
44064a |
+ TEST (q(Data::Dumper->Dumpxs([$v], ["v"])), 'glob purity: Dumpxs()') if $XS;
|
|
|
44064a |
+}
|
|
|
44064a |
--
|
|
|
44064a |
2.13.6
|
|
|
44064a |
|