Re: Copious warnings from Sys::Syslog
[p5sagit/p5-mst-13.2.git] / lib / Class / Struct.t
1 #!./perl -w
2
3 BEGIN {
4         chdir 't' if -d 't';
5         @INC = '../lib';
6 }
7
8 print "1..12\n";
9
10 package aClass;
11
12 sub new { bless {}, shift }
13
14 sub meth { 42 }
15
16 package RecClass;
17
18 sub new { bless {}, shift }
19
20 package MyObj;
21
22 use Class::Struct;
23 use Class::Struct 'struct'; # test out both forms
24
25 use Class::Struct SomeClass => { SomeElem => '$' };
26
27 struct( s => '$', a => '@', h => '%', c => 'aClass' );
28
29 my $obj = MyObj->new;
30
31 $obj->s('foo');
32
33 print "not " unless $obj->s() eq 'foo';
34 print "ok 1\n";
35
36 my $arf = $obj->a;
37
38 print "not " unless ref $arf eq 'ARRAY';
39 print "ok 2\n";
40
41 $obj->a(2, 'secundus');
42
43 print "not " unless $obj->a(2) eq 'secundus';
44 print "ok 3\n";
45
46 my $hrf = $obj->h;
47
48 print "not " unless ref $hrf eq 'HASH';
49 print "ok 4\n";
50
51 $obj->h('x', 10);
52
53 print "not " unless $obj->h('x') == 10;
54 print "ok 5\n";
55
56 my $orf = $obj->c;
57
58 print "not " if defined($orf);
59 print "ok 6\n";
60
61 $obj = MyObj->new( c => aClass->new );
62 $orf = $obj->c;
63
64 print "not " if ref $orf ne 'aClass';
65 print "ok 7\n";
66
67 print "not " unless $obj->c->meth() == 42;
68 print "ok 8\n";
69
70 my $obk = SomeClass->new();
71
72 $obk->SomeElem(123);
73
74 print "not " unless $obk->SomeElem() == 123;
75 print "ok 9\n";
76
77 $obj->a([4,5,6]);
78
79 print "not " unless $obj->a(1) == 5;
80 print "ok 10\n";
81
82 $obj->h({h=>7,r=>8,f=>9});
83
84 print "not " unless $obj->h('r') == 8;
85 print "ok 11\n";
86
87 my $recobj = RecClass->new() or print "not ";
88 print "ok 12\n";
89