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.
135 lines
3.7 KiB
135 lines
3.7 KiB
10 months ago
|
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
|
||
|
|
|