1#!./perl -w 2 3BEGIN { 4 chdir 't' if -d 't'; 5 @INC = '../lib'; 6} 7 8# 9# A couple of simple classes to use as struct elements. 10# 11package aClass; 12sub new { bless {}, shift } 13sub meth { 42 } 14 15package RecClass; 16sub new { bless {}, shift } 17 18# 19# The first of our Class::Struct based objects. 20# 21package MyObj; 22use Class::Struct; 23use Class::Struct 'struct'; # test out both forms 24use Class::Struct SomeClass => { SomeElem => '$' }; 25 26struct( s => '$', a => '@', h => '%', c => 'aClass' ); 27 28# 29# The second Class::Struct objects: 30# test the 'compile-time without package name' feature. 31# 32package MyOther; 33use Class::Struct s => '$', a => '@', h => '%', c => 'aClass'; 34 35# 36# back to main... 37# 38package main; 39 40use Test::More tests => 24; 41 42my $obj = MyObj->new; 43isa_ok $obj, 'MyObj'; 44 45$obj->s('foo'); 46is $obj->s(), 'foo'; 47 48isa_ok $obj->a, 'ARRAY'; 49$obj->a(2, 'secundus'); 50is $obj->a(2), 'secundus'; 51 52$obj->a([4,5,6]); 53is $obj->a(1), 5; 54 55isa_ok $obj->h, 'HASH'; 56$obj->h('x', 10); 57is $obj->h('x'), 10; 58 59$obj->h({h=>7,r=>8,f=>9}); 60is $obj->h('r'), 8; 61 62is $obj->c, undef; 63 64$obj = MyObj->new( c => aClass->new ); 65isa_ok $obj->c, 'aClass'; 66is $obj->c->meth(), 42; 67 68 69$obj = MyOther->new; 70isa_ok $obj, 'MyOther'; 71 72$obj->s('foo'); 73is $obj->s(), 'foo'; 74 75isa_ok $obj->a, 'ARRAY'; 76$obj->a(2, 'secundus'); 77is $obj->a(2), 'secundus'; 78 79$obj->a([4,5,6]); 80is $obj->a(1), 5; 81 82isa_ok $obj->h, 'HASH'; 83$obj->h('x', 10); 84is $obj->h('x'), 10; 85 86$obj->h({h=>7,r=>8,f=>9}); 87is $obj->h('r'), 8; 88 89is $obj->c, undef; 90 91$obj = MyOther->new( c => aClass->new ); 92isa_ok $obj->c, 'aClass'; 93is $obj->c->meth(), 42; 94 95 96 97my $obk = SomeClass->new(); 98$obk->SomeElem(123); 99is $obk->SomeElem(), 123; 100 101my $recobj = RecClass->new(); 102isa_ok $recobj, 'RecClass'; 103 104