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