remove some undocumented apis from our tests
[gitmo/Class-MOP.git] / t / 081_meta_package_extension.t
CommitLineData
a5e51f0b 1use strict;
2use warnings;
3
86a4d873 4use Test::More;
871e9eb5 5use Test::Fatal;
a5e51f0b 6
86a4d873 7use Class::MOP;
a5e51f0b 8
9{
407a4276 10 package My::Package::Stash;
a5e51f0b 11 use strict;
12 use warnings;
86a4d873 13
407a4276 14 use base 'Package::Stash';
86a4d873 15
407a4276 16 use metaclass;
17
18 use Symbol 'gensym';
86a4d873 19
a5e51f0b 20 __PACKAGE__->meta->add_attribute(
1aeb4c53 21 'namespace' => (
56dcfc1a 22 reader => 'namespace',
a5e51f0b 23 default => sub { {} }
24 )
86a4d873 25 );
26
407a4276 27 sub new {
28 my $class = shift;
29 $class->meta->new_object(__INSTANCE__ => $class->SUPER::new(@_));
30 }
31
a5e51f0b 32 sub add_package_symbol {
33 my ($self, $variable, $initial_value) = @_;
86a4d873 34
46fccbab 35 (my $name = $variable) =~ s/^[\$\@\%\&]//;
86a4d873 36
a5e51f0b 37 my $glob = gensym();
38 *{$glob} = $initial_value if defined $initial_value;
86a4d873 39 $self->namespace->{$name} = *{$glob};
40 }
a5e51f0b 41}
42
407a4276 43{
44 package My::Meta::Package;
45
46 use strict;
47 use warnings;
48
49 use base 'Class::MOP::Package';
50
51 sub _package_stash {
52 $_[0]->{_package_stash} ||= My::Package::Stash->new($_[0]->name);
53 }
54}
55
a5e51f0b 56# No actually package Foo exists :)
a5e51f0b 57my $meta = My::Meta::Package->initialize('Foo');
58
59isa_ok($meta, 'My::Meta::Package');
60isa_ok($meta, 'Class::MOP::Package');
61
62ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
63ok(!$meta->has_package_symbol('%foo'), '... the meta agrees');
64
871e9eb5 65is( exception {
a5e51f0b 66 $meta->add_package_symbol('%foo' => { one => 1 });
871e9eb5 67}, undef, '... the %foo symbol is created succcessfully' );
a5e51f0b 68
69ok(!defined($Foo::{foo}), '... the %foo slot has not been created in the actual Foo package');
70ok($meta->has_package_symbol('%foo'), '... the meta agrees');
71
72my $foo = $meta->get_package_symbol('%foo');
73is_deeply({ one => 1 }, $foo, '... got the right package variable back');
74
75$foo->{two} = 2;
76
77is($foo, $meta->get_package_symbol('%foo'), '... our %foo is the same as the metas');
78
79ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
80
871e9eb5 81is( exception {
a5e51f0b 82 $meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
871e9eb5 83}, undef, '... created @Foo::bar successfully' );
a5e51f0b 84
85ok(!defined($Foo::{bar}), '... the @bar slot has still not been created');
86
87ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet');
88
871e9eb5 89is( exception {
a5e51f0b 90 $meta->add_package_symbol('%baz');
871e9eb5 91}, undef, '... created %Foo::baz successfully' );
a5e51f0b 92
93ok(!defined($Foo::{baz}), '... the %baz slot has still not been created');
94
86a4d873 95done_testing;