Commit | Line | Data |
a5e51f0b |
1 | use strict; |
2 | use warnings; |
3 | |
efd3d14c |
4 | use Test::More tests => 15; |
a5e51f0b |
5 | use Test::Exception; |
6 | |
efd3d14c |
7 | BEGIN {use Class::MOP; |
a5e51f0b |
8 | } |
9 | |
10 | { |
11 | package My::Meta::Package; |
12 | |
13 | use strict; |
14 | use warnings; |
15 | |
16 | use Carp 'confess'; |
17 | use Symbol 'gensym'; |
18 | |
19 | use base 'Class::MOP::Package'; |
20 | |
21 | __PACKAGE__->meta->add_attribute( |
1aeb4c53 |
22 | 'namespace' => ( |
56dcfc1a |
23 | reader => 'namespace', |
a5e51f0b |
24 | default => sub { {} } |
25 | ) |
26 | ); |
27 | |
28 | sub add_package_symbol { |
29 | my ($self, $variable, $initial_value) = @_; |
30 | |
31 | my ($name, $sigil, $type) = $self->_deconstruct_variable_name($variable); |
32 | |
33 | my $glob = gensym(); |
34 | *{$glob} = $initial_value if defined $initial_value; |
35 | $self->namespace->{$name} = $glob; |
36 | } |
37 | } |
38 | |
39 | # No actually package Foo exists :) |
a5e51f0b |
40 | my $meta = My::Meta::Package->initialize('Foo'); |
41 | |
42 | isa_ok($meta, 'My::Meta::Package'); |
43 | isa_ok($meta, 'Class::MOP::Package'); |
44 | |
45 | ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet'); |
46 | ok(!$meta->has_package_symbol('%foo'), '... the meta agrees'); |
47 | |
48 | lives_ok { |
49 | $meta->add_package_symbol('%foo' => { one => 1 }); |
50 | } '... the %foo symbol is created succcessfully'; |
51 | |
52 | ok(!defined($Foo::{foo}), '... the %foo slot has not been created in the actual Foo package'); |
53 | ok($meta->has_package_symbol('%foo'), '... the meta agrees'); |
54 | |
55 | my $foo = $meta->get_package_symbol('%foo'); |
56 | is_deeply({ one => 1 }, $foo, '... got the right package variable back'); |
57 | |
58 | $foo->{two} = 2; |
59 | |
60 | is($foo, $meta->get_package_symbol('%foo'), '... our %foo is the same as the metas'); |
61 | |
62 | ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet'); |
63 | |
64 | lives_ok { |
65 | $meta->add_package_symbol('@bar' => [ 1, 2, 3 ]); |
66 | } '... created @Foo::bar successfully'; |
67 | |
68 | ok(!defined($Foo::{bar}), '... the @bar slot has still not been created'); |
69 | |
70 | ok(!defined($Foo::{baz}), '... the %baz slot has not been created yet'); |
71 | |
72 | lives_ok { |
73 | $meta->add_package_symbol('%baz'); |
74 | } '... created %Foo::baz successfully'; |
75 | |
76 | ok(!defined($Foo::{baz}), '... the %baz slot has still not been created'); |
77 | |