t/mro/basic_05_dfs_utf8.t

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