better diagnostics for get_symbol issues on bare anon stashes

[gitmo/Package-Stash.git] / lib / Package / Stash / PP.pm

diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index 121a57e..8d95840 100644 (file)
--- a/lib/Package/Stash/PP.pm
+++ b/lib/Package/Stash/PP.pm
@@ -16,6 +16,9 @@ use constant BROKEN_WEAK_STASH     => ($] < 5.010);
 # before 5.10, the scalar slot was always treated as existing if the
 # glob existed
 use constant BROKEN_SCALAR_INITIALIZATION => ($] < 5.010);
+# add_method on anon stashes triggers rt.perl #1804 otherwise
+# fixed in perl commit v5.13.3-70-g0fe688f
+use constant BROKEN_GLOB_ASSIGNMENT => ($] < 5.013004);
 
 =head1 SYNOPSIS
 
@@ -36,6 +39,10 @@ sub new {
               . "package to access";
     }
     elsif (ref($package) && reftype($package) eq 'HASH') {
+        confess "The PP implementation of Package::Stash does not support "
+              . "anonymous stashes before perl 5.14"
+            if BROKEN_GLOB_ASSIGNMENT;
+
         return bless {
             'namespace' => $package,
         }, $class;
@@ -81,6 +88,10 @@ sub namespace {
     }
 }
 
+sub _is_anon {
+    return !defined $_[0]->{package};
+}
+
 {
     my %SIGIL_MAP = (
         '$' => 'SCALAR',
@@ -158,10 +169,26 @@ sub add_symbol {
         }
     }
 
-    my $namespace = $self->namespace;
-    $namespace->{$name} ||= *{ Symbol::gensym() };
-    *{ $namespace->{$name} } = ref $initial_value
-        ? $initial_value : \$initial_value;
+    if (BROKEN_GLOB_ASSIGNMENT) {
+        if (@_ > 2) {
+            no strict 'refs';
+            *{ $self->name . '::' . $name } = ref $initial_value
+                ? $initial_value : \$initial_value;
+        }
+        else {
+            no strict 'refs';
+            *{ $self->name . '::' . $name };
+        }
+    }
+    else {
+        my $namespace = $self->namespace;
+        $namespace->{$name} ||= *{ Symbol::gensym() };
+
+        if (@_ > 2) {
+            *{ $namespace->{$name} } = ref $initial_value
+                ? $initial_value : \$initial_value;
+        }
+    }
 }
 
 sub remove_glob {
@@ -247,17 +274,25 @@ sub get_symbol {
     }
     else {
         if ($type eq 'CODE') {
+            if (BROKEN_GLOB_ASSIGNMENT || !$self->_is_anon) {
+                no strict 'refs';
+                return \&{ $self->name . '::' . $name };
+            }
+
             # XXX we should really be able to support arbitrary anonymous
             # stashes here... (not just via Package::Anon)
             if (blessed($namespace) && $namespace->isa('Package::Anon')) {
-                # ->can will call gv_init for us
+                # ->can will call gv_init for us, which inflates the glob
+                # don't know how to do this in general
                 $namespace->bless(\(my $foo))->can($name);
-                return *{ $namespace->{$name} }{CODE};
             }
             else {
-                no strict 'refs';
-                return \&{ $self->name . '::' . $name };
+                confess "Don't know how to inflate a " . ref($entry_ref)
+                      . " into a full coderef (perhaps you could use"
+                      . " Package::Anon instead of a bare stash?)"
             }
+
+            return *{ $namespace->{$name} }{CODE};
         }
         else {
             return undef;