From: Jesse Luehrs <doy@tozt.net>
Date: Tue, 29 Nov 2011 19:32:12 +0000 (-0600)
Subject: this is only going to work on 5.14
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d93368f69fbfbea0dcc645a0da00e13d7394eb94;p=gitmo%2FPackage-Stash.git

this is only going to work on 5.14
---

diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index 67e4658..4996c39 100644
--- 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;
@@ -158,12 +165,25 @@ sub add_symbol {
         }
     }
 
-    my $namespace = $self->namespace;
-    $namespace->{$name} ||= *{ Symbol::gensym() };
+    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;
+        if (@_ > 2) {
+            *{ $namespace->{$name} } = ref $initial_value
+                ? $initial_value : \$initial_value;
+        }
     }
 }
 
@@ -252,7 +272,9 @@ sub get_symbol {
         if ($type eq 'CODE') {
             # XXX we should really be able to support arbitrary anonymous
             # stashes here... (not just via Package::Anon)
-            if (blessed($namespace) && $namespace->isa('Package::Anon')) {
+            if (!BROKEN_GLOB_ASSIGNMENT
+                && blessed($namespace)
+                && $namespace->isa('Package::Anon')) {
                 # ->can will call gv_init for us
                 $namespace->bless(\(my $foo))->can($name);
                 return *{ $namespace->{$name} }{CODE};
diff --git a/t/anon-basic.t b/t/anon-basic.t
index 7ecf97d..661430a 100644
--- a/t/anon-basic.t
+++ b/t/anon-basic.t
@@ -9,6 +9,9 @@ use Test::Requires 'Package::Anon';
 use Package::Stash;
 use Symbol;
 
+plan skip_all => "Anonymous stashes in PP need at least perl 5.14"
+    if Package::Stash::BROKEN_GLOB_ASSIGNMENT;
+
 my $Foo = Package::Anon->new('Foo');
 $Foo->{SOME_CONSTANT} = \1;
 
diff --git a/t/anon.t b/t/anon.t
index bdfbe42..1816534 100644
--- a/t/anon.t
+++ b/t/anon.t
@@ -10,6 +10,9 @@ use Test::Requires 'Package::Anon';
 use Package::Stash;
 use Symbol;
 
+plan skip_all => "Anonymous stashes in PP need at least perl 5.14"
+    if Package::Stash::BROKEN_GLOB_ASSIGNMENT;
+
 my $anon = Package::Anon->new;
 my $stash = Package::Stash->new($anon);
 my $obj = $anon->bless({});