|
 |
e448c1 |
From 69beb4272d324bb0724b140b5ddca517e90d89b9 Mon Sep 17 00:00:00 2001
|
|
|
e448c1 |
From: =?UTF-8?q?Petr=20P=C3=ADsa=C5=99?= <ppisar@redhat.com>
|
|
|
e448c1 |
Date: Tue, 5 Dec 2017 10:59:42 +0100
|
|
|
e448c1 |
Subject: [PATCH] in Data-Dumper, quote glob names better
|
|
|
e448c1 |
MIME-Version: 1.0
|
|
|
e448c1 |
Content-Type: text/plain; charset=UTF-8
|
|
|
e448c1 |
Content-Transfer-Encoding: 8bit
|
|
|
e448c1 |
|
|
|
e448c1 |
Ported to Data-Dumper-1.167 from perl git tree:
|
|
|
e448c1 |
|
|
|
e448c1 |
commit abda9fe0fe75ae824723761c1c98af958f17a41c
|
|
|
e448c1 |
Author: Zefram <zefram@fysh.org>
|
|
|
e448c1 |
Date: Fri Dec 1 17:35:35 2017 +0000
|
|
|
e448c1 |
|
|
|
e448c1 |
in Data-Dumper, quote glob names better
|
|
|
e448c1 |
|
|
|
e448c1 |
Glob name quoting should obey Useqq. Fixes [perl #119831].
|
|
|
e448c1 |
|
|
|
e448c1 |
Signed-off-by: Petr Písař <ppisar@redhat.com>
|
|
|
e448c1 |
---
|
|
|
e448c1 |
Dumper.pm | 4 ++--
|
|
|
e448c1 |
Dumper.xs | 22 +++++++---------------
|
|
|
e448c1 |
t/dumper.t | 35 ++++++++++++++++++++++++++++++++++-
|
|
|
e448c1 |
3 files changed, 43 insertions(+), 18 deletions(-)
|
|
|
e448c1 |
|
|
|
e448c1 |
diff --git a/Dumper.pm b/Dumper.pm
|
|
|
e448c1 |
index 00f6326..696964a 100644
|
|
|
e448c1 |
--- a/Dumper.pm
|
|
|
e448c1 |
+++ b/Dumper.pm
|
|
|
e448c1 |
@@ -527,8 +527,8 @@ sub _dump {
|
|
|
e448c1 |
$ref = \$val;
|
|
|
e448c1 |
if (ref($ref) eq 'GLOB') { # glob
|
|
|
e448c1 |
my $name = substr($val, 1);
|
|
|
e448c1 |
- if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
|
|
|
e448c1 |
- $name =~ s/^main::/::/;
|
|
|
e448c1 |
+ $name =~ s/^main::(?!\z)/::/;
|
|
|
e448c1 |
+ 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::') {
|
|
|
e448c1 |
$sname = $name;
|
|
|
e448c1 |
}
|
|
|
e448c1 |
else {
|
|
|
e448c1 |
diff --git a/Dumper.xs b/Dumper.xs
|
|
|
e448c1 |
index 5a21721..8a16e04 100644
|
|
|
e448c1 |
--- a/Dumper.xs
|
|
|
e448c1 |
+++ b/Dumper.xs
|
|
|
e448c1 |
@@ -1300,29 +1300,21 @@ 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 |
-#ifdef GvNAMEUTF8
|
|
|
e448c1 |
- if (GvNAMEUTF8(val)) {
|
|
|
e448c1 |
sv_grow(retval, SvCUR(retval)+2);
|
|
|
e448c1 |
r = SvPVX(retval)+SvCUR(retval);
|
|
|
e448c1 |
r[0] = '*'; r[1] = '{';
|
|
|
e448c1 |
SvCUR_set(retval, SvCUR(retval)+2);
|
|
|
e448c1 |
- esc_q_utf8(aTHX_ retval, c, i, 1, style->useqq);
|
|
|
e448c1 |
+ esc_q_utf8(aTHX_ retval, c, i,
|
|
|
e448c1 |
+#ifdef GvNAMEUTF8
|
|
|
e448c1 |
+ !!GvNAMEUTF8(val)
|
|
|
e448c1 |
+#else
|
|
|
e448c1 |
+ 0
|
|
|
e448c1 |
+#endif
|
|
|
e448c1 |
+ , style->useqq);
|
|
|
e448c1 |
sv_grow(retval, SvCUR(retval)+2);
|
|
|
e448c1 |
r = SvPVX(retval)+SvCUR(retval);
|
|
|
e448c1 |
r[0] = '}'; r[1] = '\0';
|
|
|
e448c1 |
i = 1;
|
|
|
e448c1 |
- }
|
|
|
e448c1 |
- else
|
|
|
e448c1 |
-#endif
|
|
|
e448c1 |
- {
|
|
|
e448c1 |
- sv_grow(retval, SvCUR(retval)+6+2*i);
|
|
|
e448c1 |
- r = SvPVX(retval)+SvCUR(retval);
|
|
|
e448c1 |
- r[0] = '*'; r[1] = '{'; r[2] = '\'';
|
|
|
e448c1 |
- i += esc_q(r+3, c, i);
|
|
|
e448c1 |
- i += 3;
|
|
|
e448c1 |
- r[i++] = '\''; r[i++] = '}';
|
|
|
e448c1 |
- r[i] = '\0';
|
|
|
e448c1 |
- }
|
|
|
e448c1 |
}
|
|
|
e448c1 |
else {
|
|
|
e448c1 |
sv_grow(retval, SvCUR(retval)+i+2);
|
|
|
e448c1 |
diff --git a/t/dumper.t b/t/dumper.t
|
|
|
e448c1 |
index 643160a..0c12f34 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 = 450;
|
|
|
e448c1 |
+$TMAX = 456;
|
|
|
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 |
@@ -1740,3 +1740,36 @@ EOT
|
|
|
e448c1 |
TEST (qq(Dumper("\n")), '\n alone');
|
|
|
e448c1 |
TEST (qq(Data::Dumper::DumperX("\n")), '\n alone') if $XS;
|
|
|
e448c1 |
}
|
|
|
e448c1 |
+#############
|
|
|
e448c1 |
+our @globs = map { $_, \$_ } map { *$_ } map { $_, "s::$_" }
|
|
|
e448c1 |
+ "foo", "\1bar", "L\x{e9}on", "m\x{100}cron", "snow\x{2603}";
|
|
|
e448c1 |
+$WANT = <<'EOT';
|
|
|
e448c1 |
+#$globs = [
|
|
|
e448c1 |
+# *::foo,
|
|
|
e448c1 |
+# \*::foo,
|
|
|
e448c1 |
+# *s::foo,
|
|
|
e448c1 |
+# \*s::foo,
|
|
|
e448c1 |
+# *{"::\1bar"},
|
|
|
e448c1 |
+# \*{"::\1bar"},
|
|
|
e448c1 |
+# *{"s::\1bar"},
|
|
|
e448c1 |
+# \*{"s::\1bar"},
|
|
|
e448c1 |
+# *{"::L\351on"},
|
|
|
e448c1 |
+# \*{"::L\351on"},
|
|
|
e448c1 |
+# *{"s::L\351on"},
|
|
|
e448c1 |
+# \*{"s::L\351on"},
|
|
|
e448c1 |
+# *{"::m\x{100}cron"},
|
|
|
e448c1 |
+# \*{"::m\x{100}cron"},
|
|
|
e448c1 |
+# *{"s::m\x{100}cron"},
|
|
|
e448c1 |
+# \*{"s::m\x{100}cron"},
|
|
|
e448c1 |
+# *{"::snow\x{2603}"},
|
|
|
e448c1 |
+# \*{"::snow\x{2603}"},
|
|
|
e448c1 |
+# *{"s::snow\x{2603}"},
|
|
|
e448c1 |
+# \*{"s::snow\x{2603}"}
|
|
|
e448c1 |
+#];
|
|
|
e448c1 |
+EOT
|
|
|
e448c1 |
+{
|
|
|
e448c1 |
+ local $Data::Dumper::Useqq = 1;
|
|
|
e448c1 |
+ TEST (q(Data::Dumper->Dump([\@globs], ["globs"])), 'globs: Dump()');
|
|
|
e448c1 |
+ TEST (q(Data::Dumper->Dumpxs([\@globs], ["globs"])), 'globs: Dumpxs()')
|
|
|
e448c1 |
+ if $XS;
|
|
|
e448c1 |
+}
|
|
|
e448c1 |
--
|
|
|
e448c1 |
2.13.6
|
|
|
e448c1 |
|