Fix quoting glob names
This commit is contained in:
Petr Písař
parent
3fa0223268
commit
6788218e61
|
|
@ -0,0 +1,134 @@
|
|||
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
|
||||
|
||||
|
|
@ -1,7 +1,7 @@
|
|||
%global cpan_version 2.161
|
||||
Name: perl-Data-Dumper
|
||||
Version: 2.167
|
||||
Release: 396%{?dist}
|
||||
Release: 397%{?dist}
|
||||
Summary: Stringify perl data structures, suitable for printing and eval
|
||||
License: GPL+ or Artistic
|
||||
URL: http://search.cpan.org/dist/Data-Dumper/
|
||||
|
|
@ -11,6 +11,8 @@ Patch0: Data-Dumper-2.161-Upgrade-to-2.167.patch
|
|||
# Allow building against perl <= 5.25.5,
|
||||
# required for Data-Dumper-2.161-Upgrade-to-2.167.patch
|
||||
Patch1: Data-Dumper-2.167-Provide-SvPVCLEAR-macro.patch
|
||||
# Fix quoting glob names, RT#119831, in upsteam after perl-5.27.6
|
||||
Patch2: Data-Dumper-2.167-in-Data-Dumper-quote-glob-names-better.patch
|
||||
BuildRequires: findutils
|
||||
BuildRequires: gcc
|
||||
BuildRequires: make
|
||||
|
|
@ -59,6 +61,7 @@ structures correctly.
|
|||
%setup -q -n Data-Dumper-%{cpan_version}
|
||||
%patch0 -p1
|
||||
%patch1 -p1
|
||||
%patch2 -p1
|
||||
sed -i '/MAN3PODS/d' Makefile.PL
|
||||
|
||||
%build
|
||||
|
|
@ -82,6 +85,9 @@ make test
|
|||
%{_mandir}/man3/*
|
||||
|
||||
%changelog
|
||||
* Tue Dec 05 2017 Petr Pisar <ppisar@redhat.com> - 2.167-397
|
||||
- Fix quoting glob names (RT#119831)
|
||||
|
||||
* Thu Aug 03 2017 Fedora Release Engineering <releng@fedoraproject.org> - 2.167-396
|
||||
- Rebuilt for https://fedoraproject.org/wiki/Fedora_27_Binutils_Mass_Rebuild
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue