t/22_uninitialize.t

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