t/22_uninitialize.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More tests => 12;
   7
   8 BEGIN {
   9     use_ok('Class::C3');
  10     # uncomment this line, and re-run the
  11     # test to see the normal p5 dispatch order
  12     #$Class::C3::TURN_OFF_C3 = 1;
  13 }
  14
  15 =pod
  16
  17    <A>
  18   /   \
  19 <B>   <C>
  20   \   /
  21    <D>
  22
  23 =cut
  24
  25 {
  26     package Diamond_A;
  27     use Class::C3;
  28     sub hello { 'Diamond_A::hello' }
  29 }
  30 {
  31     package Diamond_B;
  32     use base 'Diamond_A';
  33     use Class::C3;
  34 }
  35 {
  36     package Diamond_C;
  37     use Class::C3;
  38     use base 'Diamond_A';
  39     sub goodbye { 'Diamond_C::goodbye' }
  40     sub hello   { 'Diamond_C::hello'   }
  41 }
  42 {
  43     package Diamond_D;
  44     use base ('Diamond_B', 'Diamond_C');
  45     use Class::C3;
  46
  47     our @hello = qw(h e l l o);
  48     our $hello = 'hello';
  49     our %hello = (h => 1, e => 2, l => "3 & 4", o => 5)
  50 }
  51
  52 Class::C3::initialize();
  53
  54 is(Diamond_D->hello, 'Diamond_C::hello', '... method resolves with the correct MRO');
  55 is(Diamond_D->goodbye, 'Diamond_C::goodbye', '... method resolves with the correct MRO');
  56
  57 {
  58     no warnings 'redefine';
  59     no strict 'refs';
  60     *{"Diamond_D::goodbye"} = sub { 'Diamond_D::goodbye' };
  61 }
  62
  63 is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... method overwritten');
  64
  65 is($Diamond_D::hello, 'hello', '... our SCALAR package vars are here');
  66 is_deeply(
  67     \@Diamond_D::hello,
  68     [ qw(h e l l o) ],
  69     '... our ARRAY package vars are here');
  70 is_deeply(
  71     \%Diamond_D::hello,
  72     { h => 1, e => 2, l => "3 & 4", o => 5 },
  73     '... our HASH package vars are here');
  74
  75 Class::C3::uninitialize();
  76
  77 is(Diamond_D->hello, 'Diamond_A::hello', '... method resolves with reinitialized MRO');
  78 is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... uninitialize does not mess with the manually changed method');
  79
  80 is($Diamond_D::hello, 'hello', '... our SCALAR package vars are still here');
  81 is_deeply(
  82     \@Diamond_D::hello,
  83     [ qw(h e l l o) ],
  84     '... our ARRAY package vars are still here');
  85 is_deeply(
  86     \%Diamond_D::hello,
  87     { h => 1, e => 2, l => "3 & 4", o => 5 },
  88     '... our HASH package vars are still here');
  89