summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJesse Luehrs <doy@tozt.net>2012-07-10 17:44:47 -0500
committerJesse Luehrs <doy@tozt.net>2012-07-10 17:55:30 -0500
commit7d36752dfb8434954e17524a0f6a5fb68352c1eb (patch)
tree6b1947103a2c9bd7881da64afe33397646eba499
parentdf62307a1ff48a0015984903995e4c51b3498c0a (diff)
downloadpackage-stash-7d36752dfb8434954e17524a0f6a5fb68352c1eb.tar.gz
package-stash-7d36752dfb8434954e17524a0f6a5fb68352c1eb.zip
vivify globs properly, so they pick up the right magic
-rw-r--r--lib/Package/Stash/PP.pm10
-rw-r--r--t/isa.t35
2 files changed, 40 insertions, 5 deletions
diff --git a/lib/Package/Stash/PP.pm b/lib/Package/Stash/PP.pm
index a831564..49cce98 100644
--- a/lib/Package/Stash/PP.pm
+++ b/lib/Package/Stash/PP.pm
@@ -182,7 +182,15 @@ sub add_symbol {
}
else {
my $namespace = $self->namespace;
- $namespace->{$name} ||= *{ Symbol::gensym() };
+ {
+ # using glob aliasing instead of Symbol::gensym, because otherwise,
+ # magic doesn't get applied properly.
+ # see <20120710063744.19360.qmail@lists-nntp.develooper.com> on p5p
+ local *__ANON__:: = $namespace;
+ no strict 'refs';
+ no warnings 'void';
+ *{"__ANON__::$name"};
+ }
if (@_ > 2) {
no warnings 'redefine';
diff --git a/t/isa.t b/t/isa.t
index ce852a6..f2e516f 100644
--- a/t/isa.t
+++ b/t/isa.t
@@ -12,11 +12,38 @@ use Package::Stash;
{
package Bar;
+ sub bar { }
}
-my $stash = Package::Stash->new('Foo');
-my @ISA = ('Bar');
-@{$stash->get_or_add_symbol('@ISA')} = @ISA;
-isa_ok('Foo', 'Bar');
+{
+ my $stash = Package::Stash->new('Foo');
+ my @ISA = ('Bar');
+ @{$stash->get_or_add_symbol('@ISA')} = @ISA;
+ isa_ok('Foo', 'Bar');
+ isa_ok(bless({}, 'Foo'), 'Bar');
+}
+
+{
+ package Baz;
+ sub foo { }
+}
+
+{
+ my $stash = Package::Stash->new('Quux');
+ {
+ my $isa = $stash->get_or_add_symbol('@ISA');
+ @$isa = ('Baz');
+ isa_ok('Quux', 'Baz');
+ isa_ok(bless({}, 'Quux'), 'Baz');
+ ok(Quux->can('foo'));
+ }
+ {
+ my $isa = $stash->get_or_add_symbol('@ISA');
+ @$isa = ('Bar');
+ isa_ok('Quux', 'Bar');
+ isa_ok(bless({}, 'Quux'), 'Bar');
+ ok(Quux->can('bar'));
+ }
+}
done_testing;