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