use strict; use warnings; use Test::More 'no_plan'; package AA; { use Object::InsideOut; my %aa : Field({'acc'=>'aa', 'type' => 'num'}); my $id = 1; sub id : ID { return ($id++); } } package BB; { use Object::InsideOut; my %bb : Field( { 'get' => 'bb', 'Set' => 'set_bb' } ); my %init_args : InitArgs = ( 'BB' => { 'Field' => \%bb, 'Default' => 'def', 'Regex' => qr/bb/i, }, ); } package AB; { use Object::InsideOut qw(AA BB); my %data : Field({'acc'=>'data'}); my %info : Field('gET'=>'info_get', 'SET'=>'info_set'); my %init_args : InitArgs = ( 'data' => { 'Field' => \%data, }, 'info' => { 'FIELD' => \%info, 'DEF' => '' }, ); } package foo; { use Object::InsideOut; } package main; MAIN: { my $obj; eval { $obj = AA->new(); }; ok(! $@, '->new() ' . $@); can_ok($obj, qw(new clone DESTROY CLONE aa)); ok($$obj == 1, 'Object ID: ' . $$obj); ok(! defined($obj->aa), 'No default'); ok($obj->aa(42) == 42, 'Set ->aa()'); ok($obj->aa == 42, 'Get ->aa() == ' . $obj->aa); eval { $obj = BB->new(); }; can_ok($obj, qw(bb set_bb)); ok(! $@, '->new() ' . $@); ok($$obj == 2, 'Object ID: ' . $$obj); is($obj->bb, 'def', 'Default: ' . $obj->bb); is($obj->set_bb('foo'), 'foo', 'Set ->set_bb()'); is($obj->bb, 'foo', 'Get ->bb() eq ' . $obj->bb); eval { $obj = BB->new('bB' => 'baz'); }; ok(! $@, '->new() ' . $@); ok($$obj == 3, 'Object ID: ' . $$obj); is($obj->bb, 'baz', 'Init: ' . $obj->bb); is($obj->set_bb('foo'), 'foo', 'Set ->set_bb()'); is($obj->bb, 'foo', 'Get ->bb() eq ' . $obj->bb); eval { $obj = AB->new(); }; can_ok($obj, qw(aa bb set_bb data info_get info_set)); ok(! $@, '->new() ' . $@); ok($$obj == 4, 'Object ID: ' . $$obj); is($obj->bb, 'def', 'Default: ' . $obj->bb); is($obj->set_bb('foo'), 'foo', 'Set ->set_bb()'); is($obj->bb, 'foo', 'Get ->bb() eq ' . $obj->bb); is($obj->bb, 'foo', 'Get ->bb() eq ' . $obj->bb); is($obj->info_get(), '', '->info_get() eq ' . $obj->info_get()); $obj->info_set('test'); is($obj->info_get(), 'test', 'Set: ->info_get() eq ' . $obj->info_get()); # Test that IDs are being reclaimed my $id; { my $x = foo->new(); $id = $$x; } for (1..10) { my $x = foo->new(); is($$x, $id, 'ID reclaimed'); } } exit(0); # EOF