t/20_reinitialize.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 4;
   7
   8 =pod
   9
  10 Start with this:
  11
  12    <A>
  13   /   \
  14 <B>   <C>
  15   \   /
  16    <D>
  17
  18 =cut
  19
  20 {
  21     package Diamond_A;
  22     use Class::C3;
  23     sub hello { 'Diamond_A::hello' }
  24 }
  25 {
  26     package Diamond_B;
  27     use base 'Diamond_A';
  28     use Class::C3;
  29 }
  30 {
  31     package Diamond_C;
  32     use Class::C3;
  33     use base 'Diamond_A';
  34     sub hello { 'Diamond_C::hello' }
  35 }
  36 {
  37     package Diamond_D;
  38     use base ('Diamond_B', 'Diamond_C');
  39     use Class::C3;
  40 }
  41
  42 Class::C3::initialize();
  43
  44 is_deeply(
  45     [ Class::C3::calculateMRO('Diamond_D') ],
  46     [ qw(Diamond_D Diamond_B Diamond_C Diamond_A) ],
  47     '... got the right MRO for Diamond_D');
  48
  49 =pod
  50
  51 Then change it to this:
  52
  53 <E>   <A>
  54   \  /   \
  55    <B>   <C>
  56      \   /
  57       <D>
  58
  59 =cut
  60
  61 {
  62     package Diamond_E;
  63     use Class::C3;
  64     sub hello { 'Diamond_E::hello' }
  65 }
  66
  67 {
  68     no strict 'refs';
  69     unshift @{"Diamond_B::ISA"} => 'Diamond_E';
  70 }
  71
  72 is_deeply(
  73     [ Class::C3::calculateMRO('Diamond_D') ],
  74     [ qw(Diamond_D Diamond_B Diamond_E Diamond_C Diamond_A) ],
  75     '... got the new MRO for Diamond_D');
  76
  77 # Doesn't work with core support, since reinit is not neccesary and the change
  78 #  takes effect immediately
  79 SKIP: {
  80     skip "This test does not work with a c3-patched perl interpreter", 1
  81         if $Class::C3::C3_IN_CORE;
  82     is(Diamond_D->hello, 'Diamond_C::hello', '... method still resolves with old MRO');
  83 }
  84
  85 Class::C3::reinitialize();
  86
  87 is(Diamond_D->hello, 'Diamond_E::hello', '... method resolves with reinitialized MRO');