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 is(Diamond_D->hello, 'Diamond_C::hello', '... method resolves with the correct MRO');
  53 is(Diamond_D->goodbye, 'Diamond_C::goodbye', '... method resolves with the correct MRO');
  54
  55 {
  56     no warnings 'redefine';
  57     no strict 'refs';
  58     *{"Diamond_D::goodbye"} = sub { 'Diamond_D::goodbye' };
  59 }
  60
  61 is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... method overwritten');
  62
  63 is($Diamond_D::hello, 'hello', '... our SCALAR package vars are here');
  64 is_deeply(
  65     \@Diamond_D::hello,
  66     [ qw(h e l l o) ],
  67     '... our ARRAY package vars are here');
  68 is_deeply(
  69     \%Diamond_D::hello,
  70     { h => 1, e => 2, l => "3 & 4", o => 5 },
  71     '... our HASH package vars are here');
  72
  73 Class::C3::uninitialize();
  74
  75 is(Diamond_D->hello, 'Diamond_A::hello', '... method resolves with reinitialized MRO');
  76 is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... uninitialize does not mess with the manually changed method');
  77
  78 is($Diamond_D::hello, 'hello', '... our SCALAR package vars are still here');
  79 is_deeply(
  80     \@Diamond_D::hello,
  81     [ qw(h e l l o) ],
  82     '... our ARRAY package vars are still here');
  83 is_deeply(
  84     \%Diamond_D::hello,
  85     { h => 1, e => 2, l => "3 & 4", o => 5 },
  86     '... our HASH package vars are still here');
  87