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