X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F081_meta_package_extension.t;h=4fcac7663784b69a94cef5edcb011c8868fce0ef;hb=871e9eb5d05b8b9986b2de3f4095f65a31159c56;hp=a9503b7c7d3e20cb6d42c76176f3b7d7a9096b62;hpb=efd3d14c1cf03120dfd1ed7787f8050e55bb8319;p=gitmo%2FClass-MOP.git diff --git a/t/081_meta_package_extension.t b/t/081_meta_package_extension.t index a9503b7..4fcac76 100644 --- a/t/081_meta_package_extension.t +++ b/t/081_meta_package_extension.t @@ -1,41 +1,56 @@ -#!/usr/bin/perl - use strict; use warnings; -use Test::More tests => 15; -use Test::Exception; +use Test::More; +use Test::Fatal; -BEGIN {use Class::MOP; -} +use Class::MOP; { - package My::Meta::Package; - + package My::Package::Stash; use strict; use warnings; - - use Carp 'confess'; + + use base 'Package::Stash'; + + use metaclass; + use Symbol 'gensym'; - - use base 'Class::MOP::Package'; - + __PACKAGE__->meta->add_attribute( 'namespace' => ( reader => 'namespace', default => sub { {} } ) - ); - + ); + + sub new { + my $class = shift; + $class->meta->new_object(__INSTANCE__ => $class->SUPER::new(@_)); + } + sub add_package_symbol { my ($self, $variable, $initial_value) = @_; - - my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); - + + my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); + my $glob = gensym(); *{$glob} = $initial_value if defined $initial_value; - $self->namespace->{$name} = $glob; - } + $self->namespace->{$name} = *{$glob}; + } +} + +{ + package My::Meta::Package; + + use strict; + use warnings; + + use base 'Class::MOP::Package'; + + sub _package_stash { + $_[0]->{_package_stash} ||= My::Package::Stash->new($_[0]->name); + } } # No actually package Foo exists :) @@ -47,9 +62,9 @@ isa_ok($meta, 'Class::MOP::Package'); ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet'); ok(!$meta->has_package_symbol('%foo'), '... the meta agrees'); -lives_ok { +is( exception { $meta->add_package_symbol('%foo' => { one => 1 }); -} '... the %foo symbol is created succcessfully'; +}, undef, '... the %foo symbol is created succcessfully' ); ok(!defined($Foo::{foo}), '... the %foo slot has not been created in the actual Foo package'); ok($meta->has_package_symbol('%foo'), '... the meta agrees'); @@ -63,17 +78,18 @@ is($foo, $meta->get_package_symbol('%foo'), '... our %foo is the same as the met ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); -lives_ok { +is( exception { $meta->add_package_symbol('@bar' => [ 1, 2, 3 ]); -} '... created @Foo::bar successfully'; +}, undef, '... created @Foo::bar successfully' ); ok(!defined($Foo::{bar}), '... the @bar slot has still not been created'); ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet'); -lives_ok { +is( exception { $meta->add_package_symbol('%baz'); -} '... created %Foo::baz successfully'; +}, undef, '... created %Foo::baz successfully' ); ok(!defined($Foo::{baz}), '... the %baz slot has still not been created'); +done_testing;