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