In perl.git, the branch blead has been updated
<https://perl5.git.perl.org/perl.git/commitdiff/abda9fe0fe75ae824723761c1c98af958f17a41c?hp=3c67ad9b9e6d659feb76f3acfc9f81cfe59e3660>
- Log -----------------------------------------------------------------
commit abda9fe0fe75ae824723761c1c98af958f17a41c
Author: Zefram <zef...@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].
-----------------------------------------------------------------------
Summary of changes:
dist/Data-Dumper/Dumper.pm | 8 ++++----
dist/Data-Dumper/Dumper.xs | 22 +++++++---------------
dist/Data-Dumper/t/dumper.t | 35 ++++++++++++++++++++++++++++++++++-
3 files changed, 45 insertions(+), 20 deletions(-)
diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index 8e24a014aa..441e97329e 100644
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -10,7 +10,7 @@
package Data::Dumper;
BEGIN {
- $VERSION = '2.167_02'; # Don't forget to set version and release
+ $VERSION = '2.168'; # Don't forget to set version and release
} # date in POD below!
#$| = 1;
@@ -536,8 +536,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 {
@@ -1474,7 +1474,7 @@ modify it under the same terms as Perl itself.
=head1 VERSION
-Version 2.167_02
+Version 2.168
=head1 SEE ALSO
diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index 7de87ec7eb..895838ac6b 100644
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/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/dist/Data-Dumper/t/dumper.t b/dist/Data-Dumper/t/dumper.t
index 643160a1c3..0c12f349e3 100644
--- a/dist/Data-Dumper/t/dumper.t
+++ b/dist/Data-Dumper/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;
+}
--
Perl5 Master Repository
