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