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