Commit | Line | Data |
ad6edfcb |
1 | #!./perl -w |
2 | |
3 | BEGIN { |
4 | chdir 't' if -d 't'; |
5 | @INC = '../lib'; |
6 | } |
7 | |
dd58e686 |
8 | # |
9 | # A couple of simple classes to use as struct elements. |
10 | # |
ad6edfcb |
11 | package aClass; |
ad6edfcb |
12 | sub new { bless {}, shift } |
ad6edfcb |
13 | sub meth { 42 } |
14 | |
f8aada62 |
15 | package RecClass; |
f8aada62 |
16 | sub new { bless {}, shift } |
17 | |
dd58e686 |
18 | # |
19 | # The first of our Class::Struct based objects. |
20 | # |
ad6edfcb |
21 | package MyObj; |
22633ac4 |
22 | use Class::Struct; |
23 | use Class::Struct 'struct'; # test out both forms |
ad6edfcb |
24 | use Class::Struct SomeClass => { SomeElem => '$' }; |
25 | |
26 | struct( s => '$', a => '@', h => '%', c => 'aClass' ); |
27 | |
dd58e686 |
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 |
35 | # |
36 | # back to main... |
37 | # |
38 | package main; |
ad6edfcb |
39 | |
dd58e686 |
40 | use Test::More tests => 24; |
ad6edfcb |
41 | |
dd58e686 |
42 | my $obj = MyObj->new; |
43 | isa_ok $obj, 'MyObj'; |
ad6edfcb |
44 | |
dd58e686 |
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 |
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 |
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 |
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 |
72 | $obj->s('foo'); |
73 | is $obj->s(), 'foo'; |
ad6edfcb |
74 | |
dd58e686 |
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 |
82 | isa_ok $obj->h, 'HASH'; |
83 | $obj->h('x', 10); |
84 | is $obj->h('x'), 10; |
726cfeaf |
85 | |
86 | $obj->h({h=>7,r=>8,f=>9}); |
dd58e686 |
87 | is $obj->h('r'), 8; |
726cfeaf |
88 | |
dd58e686 |
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 |
101 | my $recobj = RecClass->new(); |
102 | isa_ok $recobj, 'RecClass'; |
726cfeaf |
103 | |