[gitmo/Class-MOP.git] / t / 102_InsideOutClass_test.t

#!/usr/bin/perl

use strict;
use warnings;

use Test::More tests => 85;
use File::Spec;

BEGIN { 
    use_ok('Class::MOP');    
    require_ok(File::Spec->catdir('examples', 'InsideOutClass.pod'));
}

{
    package Foo;
    
    use strict;
    use warnings;    
    
    use metaclass (
        ':attribute_metaclass' => 'InsideOutClass::Attribute',
        ':instance_metaclass'  => 'InsideOutClass::Instance'
    );
    
    Foo->meta->add_attribute('foo' => (
        accessor  => 'foo',
        predicate => 'has_foo',
    ));
    
    Foo->meta->add_attribute('bar' => (
        reader  => 'get_bar',
        writer  => 'set_bar',
        default => 'FOO is BAR'            
    ));
    
    sub new  {
        my $class = shift;
        $class->meta->new_object(@_);
    }
    
    package Bar;
    
    use strict;
    use warnings;
    
    use base 'Foo';
    
    Bar->meta->add_attribute('baz' => (
        accessor  => 'baz',
        predicate => 'has_baz',
    ));   
    
    package Baz;
    
    use strict;
    use warnings;
    use metaclass (     
        ':attribute_metaclass' => 'InsideOutClass::Attribute',
        ':instance_metaclass'  => 'InsideOutClass::Instance'
    );
    
    Baz->meta->add_attribute('bling' => (
        accessor  => 'bling',
        default   => 'Baz::bling'
    ));     
    
    package Bar::Baz;
    
    use strict;
    use warnings;
    
    use base 'Bar', 'Baz';    
}

my $foo = Foo->new();
isa_ok($foo, 'Foo');

can_ok($foo, 'foo');
can_ok($foo, 'has_foo');
can_ok($foo, 'get_bar');
can_ok($foo, 'set_bar');

ok(!$foo->has_foo, '... Foo::foo is not defined yet');
is($foo->foo(), undef, '... Foo::foo is not defined yet');
is($foo->get_bar(), 'FOO is BAR', '... Foo::bar has been initialized');

$foo->foo('This is Foo');

ok($foo->has_foo, '... Foo::foo is defined now');
is($foo->foo(), 'This is Foo', '... Foo::foo == "This is Foo"');

$foo->set_bar(42);
is($foo->get_bar(), 42, '... Foo::bar == 42');

my $foo2 = Foo->new();
isa_ok($foo2, 'Foo');

ok(!$foo2->has_foo, '... Foo2::foo is not defined yet');
is($foo2->foo(), undef, '... Foo2::foo is not defined yet');
is($foo2->get_bar(), 'FOO is BAR', '... Foo2::bar has been initialized');

$foo2->set_bar('DONT PANIC');
is($foo2->get_bar(), 'DONT PANIC', '... Foo2::bar == DONT PANIC');

is($foo->get_bar(), 42, '... Foo::bar == 42');

# now Bar ...

my $bar = Bar->new();
isa_ok($bar, 'Bar');
isa_ok($bar, 'Foo');

can_ok($bar, 'foo');
can_ok($bar, 'has_foo');
can_ok($bar, 'get_bar');
can_ok($bar, 'set_bar');
can_ok($bar, 'baz');
can_ok($bar, 'has_baz');

ok(!$bar->has_foo, '... Bar::foo is not defined yet');
is($bar->foo(), undef, '... Bar::foo is not defined yet');
is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
ok(!$bar->has_baz, '... Bar::baz is not defined yet');
is($bar->baz(), undef, '... Bar::baz is not defined yet');

$bar->foo('This is Bar::foo');

ok($bar->has_foo, '... Bar::foo is defined now');
is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"');
is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');

$bar->baz('This is Bar::baz');

ok($bar->has_baz, '... Bar::baz is defined now');
is($bar->baz(), 'This is Bar::baz', '... Bar::foo == "This is Bar"');
is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"');
is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');

# now Baz ...

my $baz = Bar::Baz->new();
isa_ok($baz, 'Bar::Baz');
isa_ok($baz, 'Bar');
isa_ok($baz, 'Foo');
isa_ok($baz, 'Baz');

can_ok($baz, 'foo');
can_ok($baz, 'has_foo');
can_ok($baz, 'get_bar');
can_ok($baz, 'set_bar');
can_ok($baz, 'baz');
can_ok($baz, 'has_baz');
can_ok($baz, 'bling');

is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');

ok(!$baz->has_foo, '... Bar::Baz::foo is not defined yet');
is($baz->foo(), undef, '... Bar::Baz::foo is not defined yet');
ok(!$baz->has_baz, '... Bar::Baz::baz is not defined yet');
is($baz->baz(), undef, '... Bar::Baz::baz is not defined yet');

$baz->foo('This is Bar::Baz::foo');

ok($baz->has_foo, '... Bar::Baz::foo is defined now');
is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');

$baz->baz('This is Bar::Baz::baz');

ok($baz->has_baz, '... Bar::Baz::baz is defined now');
is($baz->baz(), 'This is Bar::Baz::baz', '... Bar::Baz::foo == "This is Bar"');
is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');

{
    no strict 'refs';
    
    ok(*{'Foo::foo'}{HASH}, '... there is a foo package variable in Foo');
    ok(*{'Foo::bar'}{HASH}, '... there is a bar package variable in Foo');

    is(scalar(keys(%{'Foo::foo'})), 4, '... got the right number of entries for Foo::foo');
    is(scalar(keys(%{'Foo::bar'})), 4, '... got the right number of entries for Foo::bar');    

    ok(!*{'Bar::foo'}{HASH}, '... no foo package variable in Bar');
    ok(!*{'Bar::bar'}{HASH}, '... no bar package variable in Bar');
    ok(*{'Bar::baz'}{HASH}, '... there is a baz package variable in Bar');

    is(scalar(keys(%{'Bar::foo'})), 0, '... got the right number of entries for Bar::foo');
    is(scalar(keys(%{'Bar::bar'})), 0, '... got the right number of entries for Bar::bar');
    is(scalar(keys(%{'Bar::baz'})), 2, '... got the right number of entries for Bar::baz');
    
    ok(*{'Baz::bling'}{HASH}, '... there is a bar package variable in Baz');

    is(scalar(keys(%{'Baz::bling'})), 1, '... got the right number of entries for Baz::bling');        
    
    ok(!*{'Bar::Baz::foo'}{HASH}, '... no foo package variable in Bar::Baz');
    ok(!*{'Bar::Baz::bar'}{HASH}, '... no bar package variable in Bar::Baz');
    ok(!*{'Bar::Baz::baz'}{HASH}, '... no baz package variable in Bar::Baz');
    ok(!*{'Bar::Baz::bling'}{HASH}, '... no bar package variable in Baz::Baz');

    is(scalar(keys(%{'Bar::Baz::foo'})), 0, '... got the right number of entries for Bar::Baz::foo');
    is(scalar(keys(%{'Bar::Baz::bar'})), 0, '... got the right number of entries for Bar::Baz::bar');
    is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz');    
    is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling');        
}
Commit	Line	Data
52e8a34c	1	#!/usr/bin/perl
	2
	3	use strict;
	4	use warnings;
	5
62189f84	6	use Test::More tests => 85;
9ec169fe	7	use File::Spec;
52e8a34c	8
	9	BEGIN {
	10	use_ok('Class::MOP');
9ec169fe	11	require_ok(File::Spec->catdir('examples', 'InsideOutClass.pod'));
52e8a34c	12	}
	13
	14	{
	15	package Foo;
	16
f892c0f0	17	use strict;
	18	use warnings;
	19
1becdfcc	20	use metaclass (
43715282	21	':attribute_metaclass' => 'InsideOutClass::Attribute',
f892c0f0	22	':instance_metaclass' => 'InsideOutClass::Instance'
677eb158	23	);
52e8a34c	24
2e41896e	25	Foo->meta->add_attribute('foo' => (
	26	accessor => 'foo',
	27	predicate => 'has_foo',
	28	));
52e8a34c	29
2e41896e	30	Foo->meta->add_attribute('bar' => (
	31	reader => 'get_bar',
	32	writer => 'set_bar',
	33	default => 'FOO is BAR'
	34	));
52e8a34c	35
	36	sub new {
	37	my $class = shift;
5659d76e	38	$class->meta->new_object(@_);
52e8a34c	39	}
f892c0f0	40
	41	package Bar;
	42
	43	use strict;
	44	use warnings;
	45
	46	use base 'Foo';
	47
	48	Bar->meta->add_attribute('baz' => (
	49	accessor => 'baz',
	50	predicate => 'has_baz',
	51	));
	52
	53	package Baz;
	54
	55	use strict;
	56	use warnings;
1becdfcc	57	use metaclass (
43715282	58	':attribute_metaclass' => 'InsideOutClass::Attribute',
43715282	59	':instance_metaclass' => 'InsideOutClass::Instance'
f892c0f0	60	);
	61
	62	Baz->meta->add_attribute('bling' => (
	63	accessor => 'bling',
	64	default => 'Baz::bling'
	65	));
	66
	67	package Bar::Baz;
	68
	69	use strict;
	70	use warnings;
	71
	72	use base 'Bar', 'Baz';
52e8a34c	73	}
	74
	75	my $foo = Foo->new();
	76	isa_ok($foo, 'Foo');
	77
	78	can_ok($foo, 'foo');
	79	can_ok($foo, 'has_foo');
	80	can_ok($foo, 'get_bar');
	81	can_ok($foo, 'set_bar');
	82
	83	ok(!$foo->has_foo, '... Foo::foo is not defined yet');
	84	is($foo->foo(), undef, '... Foo::foo is not defined yet');
	85	is($foo->get_bar(), 'FOO is BAR', '... Foo::bar has been initialized');
	86
	87	$foo->foo('This is Foo');
	88
	89	ok($foo->has_foo, '... Foo::foo is defined now');
	90	is($foo->foo(), 'This is Foo', '... Foo::foo == "This is Foo"');
	91
	92	$foo->set_bar(42);
	93	is($foo->get_bar(), 42, '... Foo::bar == 42');
	94
	95	my $foo2 = Foo->new();
	96	isa_ok($foo2, 'Foo');
	97
	98	ok(!$foo2->has_foo, '... Foo2::foo is not defined yet');
	99	is($foo2->foo(), undef, '... Foo2::foo is not defined yet');
	100	is($foo2->get_bar(), 'FOO is BAR', '... Foo2::bar has been initialized');
	101
	102	$foo2->set_bar('DONT PANIC');
	103	is($foo2->get_bar(), 'DONT PANIC', '... Foo2::bar == DONT PANIC');
	104
	105	is($foo->get_bar(), 42, '... Foo::bar == 42');
f892c0f0	106
	107	# now Bar ...
	108
	109	my $bar = Bar->new();
	110	isa_ok($bar, 'Bar');
	111	isa_ok($bar, 'Foo');
	112
	113	can_ok($bar, 'foo');
	114	can_ok($bar, 'has_foo');
	115	can_ok($bar, 'get_bar');
	116	can_ok($bar, 'set_bar');
	117	can_ok($bar, 'baz');
	118	can_ok($bar, 'has_baz');
	119
	120	ok(!$bar->has_foo, '... Bar::foo is not defined yet');
	121	is($bar->foo(), undef, '... Bar::foo is not defined yet');
	122	is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
	123	ok(!$bar->has_baz, '... Bar::baz is not defined yet');
	124	is($bar->baz(), undef, '... Bar::baz is not defined yet');
	125
	126	$bar->foo('This is Bar::foo');
	127
	128	ok($bar->has_foo, '... Bar::foo is defined now');
	129	is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"');
	130	is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
	131
	132	$bar->baz('This is Bar::baz');
	133
	134	ok($bar->has_baz, '... Bar::baz is defined now');
	135	is($bar->baz(), 'This is Bar::baz', '... Bar::foo == "This is Bar"');
	136	is($bar->foo(), 'This is Bar::foo', '... Bar::foo == "This is Bar"');
	137	is($bar->get_bar(), 'FOO is BAR', '... Bar::bar has been initialized');
	138
	139	# now Baz ...
	140
	141	my $baz = Bar::Baz->new();
	142	isa_ok($baz, 'Bar::Baz');
	143	isa_ok($baz, 'Bar');
	144	isa_ok($baz, 'Foo');
	145	isa_ok($baz, 'Baz');
	146
	147	can_ok($baz, 'foo');
	148	can_ok($baz, 'has_foo');
	149	can_ok($baz, 'get_bar');
	150	can_ok($baz, 'set_bar');
	151	can_ok($baz, 'baz');
	152	can_ok($baz, 'has_baz');
	153	can_ok($baz, 'bling');
	154
	155	is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
	156	is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
	157
	158	ok(!$baz->has_foo, '... Bar::Baz::foo is not defined yet');
	159	is($baz->foo(), undef, '... Bar::Baz::foo is not defined yet');
	160	ok(!$baz->has_baz, '... Bar::Baz::baz is not defined yet');
	161	is($baz->baz(), undef, '... Bar::Baz::baz is not defined yet');
	162
	163	$baz->foo('This is Bar::Baz::foo');
	164
	165	ok($baz->has_foo, '... Bar::Baz::foo is defined now');
	166	is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
	167	is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
	168	is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
	169
170	$baz->baz('This is Bar::Baz::baz');
171
172	ok($baz->has_baz, '... Bar::Baz::baz is defined now');
173	is($baz->baz(), 'This is Bar::Baz::baz', '... Bar::Baz::foo == "This is Bar"');
174	is($baz->foo(), 'This is Bar::Baz::foo', '... Bar::Baz::foo == "This is Bar"');
175	is($baz->get_bar(), 'FOO is BAR', '... Bar::Baz::bar has been initialized');
176	is($baz->bling(), 'Baz::bling', '... Bar::Baz::bling has been initialized');
177
62189f84	178	{
	179	no strict 'refs';
	180
	181	ok(*{'Foo::foo'}{HASH}, '... there is a foo package variable in Foo');
	182	ok(*{'Foo::bar'}{HASH}, '... there is a bar package variable in Foo');
	183
	184	is(scalar(keys(%{'Foo::foo'})), 4, '... got the right number of entries for Foo::foo');
	185	is(scalar(keys(%{'Foo::bar'})), 4, '... got the right number of entries for Foo::bar');
	186
	187	ok(!*{'Bar::foo'}{HASH}, '... no foo package variable in Bar');
	188	ok(!*{'Bar::bar'}{HASH}, '... no bar package variable in Bar');
	189	ok(*{'Bar::baz'}{HASH}, '... there is a baz package variable in Bar');
	190
	191	is(scalar(keys(%{'Bar::foo'})), 0, '... got the right number of entries for Bar::foo');
	192	is(scalar(keys(%{'Bar::bar'})), 0, '... got the right number of entries for Bar::bar');
	193	is(scalar(keys(%{'Bar::baz'})), 2, '... got the right number of entries for Bar::baz');
	194
	195	ok(*{'Baz::bling'}{HASH}, '... there is a bar package variable in Baz');
	196
	197	is(scalar(keys(%{'Baz::bling'})), 1, '... got the right number of entries for Baz::bling');
	198
	199	ok(!*{'Bar::Baz::foo'}{HASH}, '... no foo package variable in Bar::Baz');
	200	ok(!*{'Bar::Baz::bar'}{HASH}, '... no bar package variable in Bar::Baz');
	201	ok(!*{'Bar::Baz::baz'}{HASH}, '... no baz package variable in Bar::Baz');
	202	ok(!*{'Bar::Baz::bling'}{HASH}, '... no bar package variable in Baz::Baz');
	203
	204	is(scalar(keys(%{'Bar::Baz::foo'})), 0, '... got the right number of entries for Bar::Baz::foo');
	205	is(scalar(keys(%{'Bar::Baz::bar'})), 0, '... got the right number of entries for Bar::Baz::bar');
	206	is(scalar(keys(%{'Bar::Baz::baz'})), 0, '... got the right number of entries for Bar::Baz::baz');
	207	is(scalar(keys(%{'Bar::Baz::bling'})), 0, '... got the right number of entries for Bar::Baz::bling');
	208	}