t/mro/basic_05_c3_utf8.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6 use open qw( :utf8 :std );
   7
   8 require q(./test.pl); plan(tests => 2);
   9
  10 =pod
  11
  12 This tests a strange bug found by Matt S. Trout
  13 while building DBIx::Class. Thanks Matt!!!!
  14
  15    <A>
  16   /   \
  17 <C>   <B>
  18   \   /
  19    <D>
  20
  21 =cut
  22
  23 {
  24     package Ｄiᚪၚd_A;
  25     use mro 'c3';
  26
  27     sub ᕘ { 'Ｄiᚪၚd_A::ᕘ' }
  28 }
  29 {
  30     package Ｄiᚪၚd_B;
  31     use base 'Ｄiᚪၚd_A';
  32     use mro 'c3';
  33
  34     sub ᕘ { 'Ｄiᚪၚd_B::ᕘ => ' . (shift)->SUPER::ᕘ }
  35 }
  36 {
  37     package Ｄiᚪၚd_C;
  38     use mro 'c3';
  39     use base 'Ｄiᚪၚd_A';
  40
  41 }
  42 {
  43     package Ｄiᚪၚd_D;
  44     use base ('Ｄiᚪၚd_C', 'Ｄiᚪၚd_B');
  45     use mro 'c3';
  46
  47     sub ᕘ { 'Ｄiᚪၚd_D::ᕘ => ' . (shift)->SUPER::ᕘ }
  48 }
  49
  50 ok(eq_array(
  51     mro::get_linear_isa('Ｄiᚪၚd_D'),
  52     [ qw(Ｄiᚪၚd_D Ｄiᚪၚd_C Ｄiᚪၚd_B Ｄiᚪၚd_A) ]
  53 ), '... got the right MRO for Ｄiᚪၚd_D');
  54
  55 is(Ｄiᚪၚd_D->ᕘ,
  56    'Ｄiᚪၚd_D::ᕘ => Ｄiᚪၚd_B::ᕘ => Ｄiᚪၚd_A::ᕘ',
  57    '... got the right next::method dispatch path');