t/mro/next_skip_utf8.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 require q(./test.pl); plan(tests => 10);
   7
   8 use utf8;
   9 use open qw( :utf8 :std );
  10
  11 =pod
  12
  13 This tests the classic diamond inheritance pattern.
  14
  15    <A>
  16   /   \
  17 <B>   <C>
  18   \   /
  19    <D>
  20
  21 =cut
  22
  23 {
  24     package Ｄiᚪၚd_A;
  25     use mro 'c3';
  26     sub ᴮaȐ { 'Ｄiᚪၚd_A::ᴮaȐ' }
  27     sub 바ź { 'Ｄiᚪၚd_A::바ź' }
  28 }
  29 {
  30     package Ｄiᚪၚd_B;
  31     use base 'Ｄiᚪၚd_A';
  32     use mro 'c3';
  33     sub 바ź { 'Ｄiᚪၚd_B::바ź => ' . (shift)->next::method() }
  34 }
  35 {
  36     package Ｄiᚪၚd_C;
  37     use mro 'c3';
  38     use base 'Ｄiᚪၚd_A';
  39     sub ᕘ { 'Ｄiᚪၚd_C::ᕘ' }
  40     sub buƵ { 'Ｄiᚪၚd_C::buƵ' }
  41
  42     sub woｚ { 'Ｄiᚪၚd_C::woｚ' }
  43     sub maᐇbʚ { 'Ｄiᚪၚd_C::maᐇbʚ' }
  44 }
  45 {
  46     package Ｄiᚪၚd_D;
  47     use base ('Ｄiᚪၚd_B', 'Ｄiᚪၚd_C');
  48     use mro 'c3';
  49     sub ᕘ { 'Ｄiᚪၚd_D::ᕘ => ' . (shift)->next::method() }
  50     sub ᴮaȐ { 'Ｄiᚪၚd_D::ᴮaȐ => ' . (shift)->next::method() }
  51     sub buƵ { 'Ｄiᚪၚd_D::buƵ => ' . (shift)->바ź() }
  52     sub fuz { 'Ｄiᚪၚd_D::fuz => ' . (shift)->next::method() }
  53
  54     sub woｚ { 'Ｄiᚪၚd_D::woｚ can => ' . ((shift)->next::can() ? 1 : 0) }
  55     sub noz { 'Ｄiᚪၚd_D::noz can => ' . ((shift)->next::can() ? 1 : 0) }
  56
  57     sub maᐇbʚ { 'Ｄiᚪၚd_D::maᐇbʚ => ' . ((shift)->maybe::next::method() || 0) }
  58     sub ᒧyベ { 'Ｄiᚪၚd_D::ᒧyベ => ' .    ((shift)->maybe::next::method() || 0) }
  59
  60 }
  61
  62 ok(eq_array(
  63     mro::get_linear_isa('Ｄiᚪၚd_D'),
  64     [ qw(Ｄiᚪၚd_D Ｄiᚪၚd_B Ｄiᚪၚd_C Ｄiᚪၚd_A) ]
  65 ), '... got the right MRO for Ｄiᚪၚd_D');
  66
  67 is(Ｄiᚪၚd_D->ᕘ, 'Ｄiᚪၚd_D::ᕘ => Ｄiᚪၚd_C::ᕘ', '... skipped B and went to C correctly');
  68 is(Ｄiᚪၚd_D->ᴮaȐ, 'Ｄiᚪၚd_D::ᴮaȐ => Ｄiᚪၚd_A::ᴮaȐ', '... skipped B & C and went to A correctly');
  69 is(Ｄiᚪၚd_D->바ź, 'Ｄiᚪၚd_B::바ź => Ｄiᚪၚd_A::바ź', '... called B method, skipped C and went to A correctly');
  70 is(Ｄiᚪၚd_D->buƵ, 'Ｄiᚪၚd_D::buƵ => Ｄiᚪၚd_B::바ź => Ｄiᚪၚd_A::바ź', '... called D method dispatched to , different method correctly');
  71 TODO: {
  72     local our $TODO = "Warnings aren't clean yet";
  73     eval { Ｄiᚪၚd_D->fuz };
  74     like($@, qr/^No next::method 'fuz' found for Ｄiᚪၚd_D/u, '... cannot re-dispatch to a method which is not there');
  75 }
  76 is(Ｄiᚪၚd_D->woｚ, 'Ｄiᚪၚd_D::woｚ can => 1', '... can re-dispatch figured out correctly');
  77 is(Ｄiᚪၚd_D->noz, 'Ｄiᚪၚd_D::noz can => 0', '... cannot re-dispatch figured out correctly');
  78
  79 is(Ｄiᚪၚd_D->maᐇbʚ, 'Ｄiᚪၚd_D::maᐇbʚ => Ｄiᚪၚd_C::maᐇbʚ', '... redispatched D to C when it exists');
  80 is(Ｄiᚪၚd_D->ᒧyベ, 'Ｄiᚪၚd_D::ᒧyベ => 0', '... quietly failed redispatch from D');