in Data-Dumper, quote glob names better
authorZefram <zefram@fysh.org>
Fri, 1 Dec 2017 17:35:35 +0000 (17:35 +0000)
committerZefram <zefram@fysh.org>
Fri, 1 Dec 2017 17:37:06 +0000 (17:37 +0000)
Glob name quoting should obey Useqq.  Fixes [perl #119831].

dist/Data-Dumper/Dumper.pm
dist/Data-Dumper/Dumper.xs
dist/Data-Dumper/t/dumper.t

index 8e24a01..441e973 100644 (file)
@@ -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
 
index 7de87ec..895838a 100644 (file)
@@ -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);
index 643160a..0c12f34 100644 (file)
@@ -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;
+}