summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2011-11-29 13:32:12 -0600
committerJesse Luehrs <doy@tozt.net>2011-11-29 13:47:42 -0600
commitd93368f69fbfbea0dcc645a0da00e13d7394eb94 (patch)
tree632ff648c1e17f89156f477d70aa4b06116c92f0
parent96fcd34ebc0a0cd737ddea12e98d8996b0f39036 (diff)
downloadpackage-stash-d93368f69fbfbea0dcc645a0da00e13d7394eb94.tar.gz
package-stash-d93368f69fbfbea0dcc645a0da00e13d7394eb94.zip
this is only going to work on 5.14
-rw-r--r--lib/Package/Stash/PP.pm34
-rw-r--r--t/anon-basic.t3
-rw-r--r--t/anon.t3
3 files changed, 34 insertions, 6 deletions
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({});