t/inherited.t

   1 use Test::More tests => 35;
   2 use strict;
   3 use warnings;
   4 use lib 't/lib';
   5 use SuperInheritedGroups;
   6 use NotHashBased;
   7
   8 my $super = SuperInheritedGroups->new;
   9 my $base = BaseInheritedGroups->new;
  10
  11 my @ret = SuperInheritedGroups->basefield;
  12
  13 ok(@ret == 1, 'Return value before set');
  14 ok(!defined(SuperInheritedGroups->basefield), 'Undef return before set');
  15
  16 # set base. base, super, object = base
  17 is(BaseInheritedGroups->basefield('All Your Base'), 'All Your Base');
  18 is(SuperInheritedGroups->basefield, 'All Your Base');
  19 is($super->basefield, 'All Your Base');
  20 is($base->basefield, 'All Your Base');
  21
  22 # set super. super = super, base = base, object = super
  23 is(SuperInheritedGroups->basefield('Now Its Our Base'), 'Now Its Our Base');
  24 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  25 is(BaseInheritedGroups->basefield, 'All Your Base');
  26 is($super->basefield, 'Now Its Our Base');
  27 is($base->basefield, 'All Your Base');
  28
  29 #set base
  30 is($base->basefield('First Base'), 'First Base');
  31 is($base->basefield, 'First Base');
  32 is($super->basefield, 'Now Its Our Base');
  33 is(BaseInheritedGroups->basefield, 'All Your Base');
  34 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  35
  36 # set object, object = object, super = super, base = base
  37 is($super->basefield('Third Base'), 'Third Base');
  38 is($super->basefield, 'Third Base');
  39 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  40 is(BaseInheritedGroups->basefield, 'All Your Base');
  41
  42 # create new super. new = base, object = object, super = super, base = base
  43 my $newsuper = SuperInheritedGroups->new;
  44 is($newsuper->basefield, 'Now Its Our Base');
  45 is($super->basefield, 'Third Base');
  46 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  47 is(BaseInheritedGroups->basefield, 'All Your Base');
  48
  49 # create new base. new = base, super = super, base = base
  50 my $newbase = BaseInheritedGroups->new;
  51 is($newbase->basefield, 'All Your Base');
  52 is($newsuper->basefield, 'Now Its Our Base');
  53 is($super->basefield, 'Third Base');
  54 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  55 is(BaseInheritedGroups->basefield, 'All Your Base');
  56
  57 # croak on get/set on non hash-based object
  58 my $dying = NotHashBased->new;
  59
  60 eval {
  61     $dying->killme;
  62 };
  63 ok($@ =~ /Cannot get.*is not hash-based/);
  64
  65 eval {
  66     $dying->killme('foo');
  67 };
  68 ok($@ =~ /Cannot set.*is not hash-based/);
  69
  70 # make sure we're get defined items, even 0, ''
  71 BaseInheritedGroups->basefield('base');
  72 SuperInheritedGroups->basefield(0);
  73 is(SuperInheritedGroups->basefield, 0);
  74
  75 BaseInheritedGroups->basefield('base');
  76 SuperInheritedGroups->basefield('');
  77 is(SuperInheritedGroups->basefield, '');
  78
  79 BaseInheritedGroups->basefield('base');
  80 SuperInheritedGroups->basefield(undef);
  81 is(SuperInheritedGroups->basefield, 'base');
  82
  83 is(BaseInheritedGroups->undefined, undef);