t/inherited.t

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