Make DD dump *{''} properly

This typeglob is an oddity, in that it stringifies as *main::,
but cannot be reached under that name, because *main:: produces
*main::main::.  The former is $::{""}; the latter $::{"main::"}.

I was inadvertently triggering this in 5.8 when I added a test a while
back for typeglobs will nulls in their names.

diff --git a/dist/Data-Dumper/Dumper.pm b/dist/Data-Dumper/Dumper.pm
index e3b7dbf..8018bae 100644 (file)
--- a/dist/Data-Dumper/Dumper.pm
+++ b/dist/Data-Dumper/Dumper.pm
@@ -499,12 +499,12 @@ sub _dump {
     }
     if (ref($ref) eq 'GLOB' or "$ref" =~ /=GLOB\([^()]+\)$/) {  # glob
       my $name = substr($val, 1);
-      if ($name =~ /^[A-Za-z_][\w:]*$/) {
+      if ($name =~ /^[A-Za-z_][\w:]*$/ && $name ne 'main::') {
        $name =~ s/^main::/::/;
        $sname = $name;
       }
       else {
-       $sname = $s->_dump($name, "");
+       $sname = $s->_dump($name eq 'main::' ? '' : $name, "");
        $sname = '{' . $sname . '}';
       }
       if ($s->{purity}) {

diff --git a/dist/Data-Dumper/Dumper.xs b/dist/Data-Dumper/Dumper.xs
index b6da680..30a9b40 100644 (file)
--- a/dist/Data-Dumper/Dumper.xs
+++ b/dist/Data-Dumper/Dumper.xs
@@ -918,7 +918,7 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
            if(i) ++c, --i;                     /* just get the name */
            if (i >= 6 && strncmp(c, "main::", 6) == 0) {
                c += 4;
-               i -= 4;
+               if (i == 6) i = 0; else i -= 4;
            }
            if (needs_quote(c,i)) {
 #ifdef GvNAMEUTF8

diff --git a/dist/Data-Dumper/t/bugs.t b/dist/Data-Dumper/t/bugs.t
index f0b04f8..0533765 100644 (file)
--- a/dist/Data-Dumper/t/bugs.t
+++ b/dist/Data-Dumper/t/bugs.t
@@ -12,7 +12,7 @@ BEGIN {
 }
 
 use strict;
-use Test::More tests => 13;
+use Test::More tests => 15;
 use Data::Dumper;
 
 {
@@ -123,4 +123,20 @@ SKIP: {
   &$tests;
 }
 
+{
+  # Test reference equivalence of dumping *{""}.
+  my $tests = sub {
+    my $VAR1;
+    no strict 'refs';
+    is eval(Dumper \*{""}), \*{""}, 'dumping \*{""}';
+  };
+  SKIP: {
+    skip "no XS", 1 if not defined &Data::Dumper::Dumpxs;
+    local $Data::Dumper::Useperl = 0;
+    &$tests;
+  }
+  local $Data::Dumper::Useperl = 1;
+  &$tests;
+}
+
 # EOF