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