lib/Class/Struct.t

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