t/inherited.t

   1 use Test::More tests => 29;
   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 # set base. base, super, object = base
  12 is(BaseInheritedGroups->basefield('All Your Base'), 'All Your Base');
  13 is(SuperInheritedGroups->basefield, 'All Your Base');
  14 is($super->basefield, 'All Your Base');
  15 is($base->basefield, 'All Your Base');
  16
  17 # set super. super = super, base = base, object = super
  18 is(SuperInheritedGroups->basefield('Now Its Our Base'), 'Now Its Our Base');
  19 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  20 is(BaseInheritedGroups->basefield, 'All Your Base');
  21 is($super->basefield, 'Now Its Our Base');
  22 is($base->basefield, 'All Your Base');
  23
  24 #set base
  25 is($base->basefield('First Base'), 'First Base');
  26 is($base->basefield, 'First Base');
  27 is($super->basefield, 'Now Its Our Base');
  28 is(BaseInheritedGroups->basefield, 'All Your Base');
  29 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  30
  31 # set object, object = object, super = super, base = base
  32 is($super->basefield('Third Base'), 'Third Base');
  33 is($super->basefield, 'Third Base');
  34 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  35 is(BaseInheritedGroups->basefield, 'All Your Base');
  36
  37 # create new super. new = base, object = object, super = super, base = base
  38 my $newsuper = SuperInheritedGroups->new;
  39 is($newsuper->basefield, 'Now Its Our Base');
  40 is($super->basefield, 'Third Base');
  41 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  42 is(BaseInheritedGroups->basefield, 'All Your Base');
  43
  44 # create new base. new = base, super = super, base = base
  45 my $newbase = BaseInheritedGroups->new;
  46 is($newbase->basefield, 'All Your Base');
  47 is($newsuper->basefield, 'Now Its Our Base');
  48 is($super->basefield, 'Third Base');
  49 is(SuperInheritedGroups->basefield, 'Now Its Our Base');
  50 is(BaseInheritedGroups->basefield, 'All Your Base');
  51
  52 # croak on get/set on non hash-based object
  53 my $dying = NotHashBased->new;
  54
  55 eval {
  56     $dying->killme;
  57 };
  58 ok($@ =~ /Cannot get.*is not hash-based/);
  59
  60 eval {
  61     $dying->killme('foo');
  62 };
  63 ok($@ =~ /Cannot set.*is not hash-based/);