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