From: Jesse Luehrs 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({});