[gitmo/Moose.git] / t / cmop / package_variables.t

use strict;
use warnings;

use Test::More;
use Test::Fatal;

use Class::MOP;

{
    package Foo;
    use metaclass;
}

=pod

This is the same test as 080_meta_package.t just here
we call all the methods through Class::MOP::Class.

=cut

# ----------------------------------------------------------------------
## tests adding a HASH

ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');

is( exception {
    Foo->meta->add_package_symbol('%foo' => { one => 1 });
}, undef, '... created %Foo::foo successfully' );

# ... scalar should NOT be created here

ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('&foo'), '... CODE shouldnt have been created too');

ok(defined($Foo::{foo}), '... the %foo slot was created successfully');
ok(Foo->meta->has_package_symbol('%foo'), '... the meta agrees');

# check the value ...

{
    no strict 'refs';
    ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly');
    is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly');
}

my $foo = Foo->meta->get_package_symbol('%foo');
is_deeply({ one => 1 }, $foo, '... got the right package variable back');

# ... make sure changes propogate up

$foo->{two} = 2;

{
    no strict 'refs';
    is(\%{'Foo::foo'}, Foo->meta->get_package_symbol('%foo'), '... our %foo is the same as the metas');

    ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly');
    is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly');
}

# ----------------------------------------------------------------------
## test adding an ARRAY

ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');

is( exception {
    Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
}, undef, '... created @Foo::bar successfully' );

ok(defined($Foo::{bar}), '... the @bar slot was created successfully');
ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees');

# ... why does this not work ...

ok(!Foo->meta->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('%bar'), '... HASH shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('&bar'), '... CODE shouldnt have been created too');

# check the value itself

{
    no strict 'refs';
    is(scalar @{'Foo::bar'}, 3, '... our @bar was initialized correctly');
    is(${'Foo::bar'}[1], 2, '... our @bar was initialized correctly');
}

# ----------------------------------------------------------------------
## test adding a SCALAR

ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet');

is( exception {
    Foo->meta->add_package_symbol('$baz' => 10);
}, undef, '... created $Foo::baz successfully' );

ok(defined($Foo::{baz}), '... the $baz slot was created successfully');
ok(Foo->meta->has_package_symbol('$baz'), '... the meta agrees');

ok(!Foo->meta->has_package_symbol('@baz'), '... ARRAY shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('%baz'), '... HASH shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('&baz'), '... CODE shouldnt have been created too');

is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back');

{
    no strict 'refs';
    ${'Foo::baz'} = 1;

    is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly');
    is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees');
}

# ----------------------------------------------------------------------
## test adding a CODE

ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet');

is( exception {
    Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
}, undef, '... created &Foo::funk successfully' );

ok(defined($Foo::{funk}), '... the &funk slot was created successfully');
ok(Foo->meta->has_package_symbol('&funk'), '... the meta agrees');

ok(!Foo->meta->has_package_symbol('$funk'), '... SCALAR shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('@funk'), '... ARRAY shouldnt have been created too');
ok(!Foo->meta->has_package_symbol('%funk'), '... HASH shouldnt have been created too');

{
    no strict 'refs';
    ok(defined &{'Foo::funk'}, '... our &funk exists');
}

is(Foo->funk(), 'Foo::funk', '... got the right value from the function');

# ----------------------------------------------------------------------
## test multiple slots in the glob

my $ARRAY = [ 1, 2, 3 ];
my $CODE = sub { "Foo::foo" };

is( exception {
    Foo->meta->add_package_symbol('@foo' => $ARRAY);
}, undef, '... created @Foo::foo successfully' );

ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot was added successfully');
is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');

is( exception {
    Foo->meta->add_package_symbol('&foo' => $CODE);
}, undef, '... created &Foo::foo successfully' );

ok(Foo->meta->has_package_symbol('&foo'), '... the meta agrees');
is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');

is( exception {
    Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
}, undef, '... created $Foo::foo successfully' );

ok(Foo->meta->has_package_symbol('$foo'), '... the meta agrees');
my $SCALAR = Foo->meta->get_package_symbol('$foo');
is($$SCALAR, 'Foo::foo', '... got the right scalar value back');

{
    no strict 'refs';
    is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar');
}

is( exception {
    Foo->meta->remove_package_symbol('%foo');
}, undef, '... removed %Foo::foo successfully' );

ok(!Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
ok(Foo->meta->has_package_symbol('&foo'), '... the &foo slot still exists');
ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');

is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');

{
    no strict 'refs';
    ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
    ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
    ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed');
    ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
}

is( exception {
    Foo->meta->remove_package_symbol('&foo');
}, undef, '... removed &Foo::foo successfully' );

ok(!Foo->meta->has_package_symbol('&foo'), '... the &foo slot no longer exists');

ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');

is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');

{
    no strict 'refs';
    ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
    ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');
    ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
    ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
}

is( exception {
    Foo->meta->remove_package_symbol('$foo');
}, undef, '... removed $Foo::foo successfully' );

ok(!Foo->meta->has_package_symbol('$foo'), '... the $foo slot no longer exists');

ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');

is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');

{
    no strict 'refs';
    ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
    ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');
    ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed');
    ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
}

done_testing;
Commit	Line	Data
38bf2a25	1	use strict;
	2	use warnings;
	3
	4	use Test::More;
	5	use Test::Fatal;
	6
	7	use Class::MOP;
	8
	9	{
	10	package Foo;
	11	use metaclass;
	12	}
	13
	14	=pod
	15
	16	This is the same test as 080_meta_package.t just here
	17	we call all the methods through Class::MOP::Class.
	18
	19	=cut
	20
	21	# ----------------------------------------------------------------------
	22	## tests adding a HASH
	23
	24	ok(!defined($Foo::{foo}), '... the %foo slot has not been created yet');
	25	ok(!Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
	26
	27	is( exception {
	28	Foo->meta->add_package_symbol('%foo' => { one => 1 });
	29	}, undef, '... created %Foo::foo successfully' );
	30
	31	# ... scalar should NOT be created here
	32
	33	ok(!Foo->meta->has_package_symbol('$foo'), '... SCALAR shouldnt have been created too');
	34	ok(!Foo->meta->has_package_symbol('@foo'), '... ARRAY shouldnt have been created too');
	35	ok(!Foo->meta->has_package_symbol('&foo'), '... CODE shouldnt have been created too');
	36
	37	ok(defined($Foo::{foo}), '... the %foo slot was created successfully');
	38	ok(Foo->meta->has_package_symbol('%foo'), '... the meta agrees');
	39
	40	# check the value ...
	41
	42	{
	43	no strict 'refs';
	44	ok(exists ${'Foo::foo'}{one}, '... our %foo was initialized correctly');
	45	is(${'Foo::foo'}{one}, 1, '... our %foo was initialized correctly');
	46	}
	47
	48	my $foo = Foo->meta->get_package_symbol('%foo');
	49	is_deeply({ one => 1 }, $foo, '... got the right package variable back');
	50
	51	# ... make sure changes propogate up
	52
	53	$foo->{two} = 2;
	54
	55	{
	56	no strict 'refs';
	57	is(\%{'Foo::foo'}, Foo->meta->get_package_symbol('%foo'), '... our %foo is the same as the metas');
	58
	59	ok(exists ${'Foo::foo'}{two}, '... our %foo was updated correctly');
	60	is(${'Foo::foo'}{two}, 2, '... our %foo was updated correctly');
	61	}
	62
	63	# ----------------------------------------------------------------------
	64	## test adding an ARRAY
65
66	ok(!defined($Foo::{bar}), '... the @bar slot has not been created yet');
67
68	is( exception {
69	Foo->meta->add_package_symbol('@bar' => [ 1, 2, 3 ]);
70	}, undef, '... created @Foo::bar successfully' );
71
72	ok(defined($Foo::{bar}), '... the @bar slot was created successfully');
73	ok(Foo->meta->has_package_symbol('@bar'), '... the meta agrees');
74
75	# ... why does this not work ...
76
77	ok(!Foo->meta->has_package_symbol('$bar'), '... SCALAR shouldnt have been created too');
78	ok(!Foo->meta->has_package_symbol('%bar'), '... HASH shouldnt have been created too');
79	ok(!Foo->meta->has_package_symbol('&bar'), '... CODE shouldnt have been created too');
80
81	# check the value itself
82
83	{
84	no strict 'refs';
85	is(scalar @{'Foo::bar'}, 3, '... our @bar was initialized correctly');
86	is(${'Foo::bar'}[1], 2, '... our @bar was initialized correctly');
87	}
88
89	# ----------------------------------------------------------------------
90	## test adding a SCALAR
91
92	ok(!defined($Foo::{baz}), '... the $baz slot has not been created yet');
93
94	is( exception {
95	Foo->meta->add_package_symbol('$baz' => 10);
96	}, undef, '... created $Foo::baz successfully' );
97
98	ok(defined($Foo::{baz}), '... the $baz slot was created successfully');
99	ok(Foo->meta->has_package_symbol('$baz'), '... the meta agrees');
100
101	ok(!Foo->meta->has_package_symbol('@baz'), '... ARRAY shouldnt have been created too');
102	ok(!Foo->meta->has_package_symbol('%baz'), '... HASH shouldnt have been created too');
103	ok(!Foo->meta->has_package_symbol('&baz'), '... CODE shouldnt have been created too');
104
105	is(${Foo->meta->get_package_symbol('$baz')}, 10, '... got the right value back');
106
107	{
108	no strict 'refs';
109	${'Foo::baz'} = 1;
110
111	is(${'Foo::baz'}, 1, '... our $baz was assigned to correctly');
112	is(${Foo->meta->get_package_symbol('$baz')}, 1, '... the meta agrees');
113	}
114
115	# ----------------------------------------------------------------------
116	## test adding a CODE
117
118	ok(!defined($Foo::{funk}), '... the &funk slot has not been created yet');
119
120	is( exception {
121	Foo->meta->add_package_symbol('&funk' => sub { "Foo::funk" });
122	}, undef, '... created &Foo::funk successfully' );
123
124	ok(defined($Foo::{funk}), '... the &funk slot was created successfully');
125	ok(Foo->meta->has_package_symbol('&funk'), '... the meta agrees');
126
127	ok(!Foo->meta->has_package_symbol('$funk'), '... SCALAR shouldnt have been created too');
128	ok(!Foo->meta->has_package_symbol('@funk'), '... ARRAY shouldnt have been created too');
129	ok(!Foo->meta->has_package_symbol('%funk'), '... HASH shouldnt have been created too');
130
131	{
132	no strict 'refs';
133	ok(defined &{'Foo::funk'}, '... our &funk exists');
134	}
135
136	is(Foo->funk(), 'Foo::funk', '... got the right value from the function');
137
138	# ----------------------------------------------------------------------
139	## test multiple slots in the glob
140
141	my $ARRAY = [ 1, 2, 3 ];
142	my $CODE = sub { "Foo::foo" };
143
144	is( exception {
145	Foo->meta->add_package_symbol('@foo' => $ARRAY);
146	}, undef, '... created @Foo::foo successfully' );
147
148	ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot was added successfully');
149	is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
150
151	is( exception {
152	Foo->meta->add_package_symbol('&foo' => $CODE);
153	}, undef, '... created &Foo::foo successfully' );
154
155	ok(Foo->meta->has_package_symbol('&foo'), '... the meta agrees');
156	is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
157
158	is( exception {
159	Foo->meta->add_package_symbol('$foo' => 'Foo::foo');
160	}, undef, '... created $Foo::foo successfully' );
161
162	ok(Foo->meta->has_package_symbol('$foo'), '... the meta agrees');
163	my $SCALAR = Foo->meta->get_package_symbol('$foo');
164	is($$SCALAR, 'Foo::foo', '... got the right scalar value back');
165
166	{
167	no strict 'refs';
168	is(${'Foo::foo'}, 'Foo::foo', '... got the right value from the scalar');
169	}
170
171	is( exception {
172	Foo->meta->remove_package_symbol('%foo');
173	}, undef, '... removed %Foo::foo successfully' );
174
175	ok(!Foo->meta->has_package_symbol('%foo'), '... the %foo slot was removed successfully');
176	ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
177	ok(Foo->meta->has_package_symbol('&foo'), '... the &foo slot still exists');
178	ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');
179
180	is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
181	is(Foo->meta->get_package_symbol('&foo'), $CODE, '... got the right value for &Foo::foo');
182	is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');
183
184	{
185	no strict 'refs';
186	ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
187	ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
188	ok(defined(*{"Foo::foo"}{CODE}), '... the &foo slot has NOT been removed');
189	ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
190	}
191
192	is( exception {
193	Foo->meta->remove_package_symbol('&foo');
194	}, undef, '... removed &Foo::foo successfully' );
195
196	ok(!Foo->meta->has_package_symbol('&foo'), '... the &foo slot no longer exists');
197
198	ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
199	ok(Foo->meta->has_package_symbol('$foo'), '... the $foo slot still exists');
200
201	is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
202	is(Foo->meta->get_package_symbol('$foo'), $SCALAR, '... got the right value for $Foo::foo');
203
204	{
205	no strict 'refs';
206	ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
207	ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');
208	ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
209	ok(defined(${"Foo::foo"}), '... the $foo slot has NOT been removed');
210	}
211
212	is( exception {
213	Foo->meta->remove_package_symbol('$foo');
214	}, undef, '... removed $Foo::foo successfully' );
215
216	ok(!Foo->meta->has_package_symbol('$foo'), '... the $foo slot no longer exists');
217
218	ok(Foo->meta->has_package_symbol('@foo'), '... the @foo slot still exists');
219
220	is(Foo->meta->get_package_symbol('@foo'), $ARRAY, '... got the right values for @Foo::foo');
221
222	{
223	no strict 'refs';
224	ok(!defined(*{"Foo::foo"}{HASH}), '... the %foo slot has been removed successfully');
225	ok(!defined(*{"Foo::foo"}{CODE}), '... the &foo slot has now been removed');
226	ok(!defined(${"Foo::foo"}), '... the $foo slot has now been removed');
227	ok(defined(*{"Foo::foo"}{ARRAY}), '... the @foo slot has NOT been removed');
228	}
229
230	done_testing;