t/mro/next_method_utf8.t

   1 #!/usr/bin/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 => 5);
   9
  10 =pod
  11
  12 This tests the classic diamond inheritance pattern.
  13
  14    <A>
  15   /   \
  16 <B>   <C>
  17   \   /
  18    <D>
  19
  20 =cut
  21
  22 {
  23     package Diӑmond_A;
  24     use mro 'c3';
  25     sub 헬ฬ { 'Diӑmond_A::헬ฬ' }
  26     sub fಓ { 'Diӑmond_A::fಓ' }
  27 }
  28 {
  29     package Diӑmond_B;
  30     use base 'Diӑmond_A';
  31     use mro 'c3';
  32     sub fಓ { 'Diӑmond_B::fಓ => ' . (shift)->next::method() }
  33 }
  34 {
  35     package Diӑmond_C;
  36     use mro 'c3';
  37     use base 'Diӑmond_A';
  38
  39     sub 헬ฬ { 'Diӑmond_C::헬ฬ => ' . (shift)->next::method() }
  40     sub fಓ { 'Diӑmond_C::fಓ => ' . (shift)->next::method() }
  41 }
  42 {
  43     package Diӑmond_D;
  44     use base ('Diӑmond_B', 'Diӑmond_C');
  45     use mro 'c3';
  46
  47     sub fಓ { 'Diӑmond_D::fಓ => ' . (shift)->next::method() }
  48 }
  49
  50 ok(eq_array(
  51     mro::get_linear_isa('Diӑmond_D'),
  52     [ qw(Diӑmond_D Diӑmond_B Diӑmond_C Diӑmond_A) ]
  53 ), '... got the right MRO for Diӑmond_D');
  54
  55 is(Diӑmond_D->헬ฬ, 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ', '... method resolved itself as expected');
  56
  57 is(Diӑmond_D->can('헬ฬ')->('Diӑmond_D'),
  58    'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ',
  59    '... can(method) resolved itself as expected');
  60
  61 is(UNIVERSAL::can("Diӑmond_D", '헬ฬ')->('Diӑmond_D'),
  62    'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ',
  63    '... can(method) resolved itself as expected');
  64
  65 is(Diӑmond_D->fಓ,
  66     'Diӑmond_D::fಓ => Diӑmond_B::fಓ => Diӑmond_C::fಓ => Diӑmond_A::fಓ',
  67     '... method fಓ resolved itself as expected');