This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make MM_VMS::oneline build continuation lines properly.
[perl5.git] / t / mro / next_method_utf8.t
CommitLineData
204e6232
BF
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5use utf8;
6use open qw( :utf8 :std );
7
8require q(./test.pl); plan(tests => 5);
9
10=pod
11
12This 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
50ok(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
55is(Diӑmond_D->헬ฬ, 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ', '... method resolved itself as expected');
56
57is(Diӑmond_D->can('헬ฬ')->('Diӑmond_D'),
58 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ',
59 '... can(method) resolved itself as expected');
60
61is(UNIVERSAL::can("Diӑmond_D", '헬ฬ')->('Diӑmond_D'),
62 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ',
63 '... can(method) resolved itself as expected');
64
65is(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');