summaryrefslogtreecommitdiff
path: root/t/mro
diff options
context:
space:
mode:
authorBrian Fraser <fraserbn@gmail.com>2011-07-06 10:41:10 -0300
committerFather Chrysostomos <sprout@cpan.org>2011-10-06 13:01:10 -0700
commit204e6232679d0d412347fddd9e5bd0e529da73d5 (patch)
treef277f72f11f914e9b6c9874e5e48c22d56ba27a1 /t/mro
parenta00b390b6689672af8817e28321f92e70369c0d4 (diff)
downloadperl-204e6232679d0d412347fddd9e5bd0e529da73d5.tar.gz
mro UTF8 cleanup.
This patch also duplicates existing mro tests with copies that use Unicode in identifiers, to test the mro code. Since those tests trigger it, it also fixes a bug in the parsing of *{...}: If the first character inside the braces is a non-ASCII Unicode identifier character, the inside is now implicitly quoted if it is just an identifier (just as it is with ASCII identifiers), instead of being parsed as a bareword that would violate strict subs.
Diffstat (limited to 't/mro')
-rw-r--r--t/mro/basic_01_c3_utf8.t49
-rw-r--r--t/mro/basic_01_dfs_utf8.t49
-rw-r--r--t/mro/basic_02_c3_utf8.t117
-rw-r--r--t/mro/basic_02_dfs_utf8.t117
-rw-r--r--t/mro/basic_03_c3_utf8.t103
-rw-r--r--t/mro/basic_03_dfs_utf8.t103
-rw-r--r--t/mro/basic_04_c3_utf8.t36
-rw-r--r--t/mro/basic_04_dfs_utf8.t36
-rw-r--r--t/mro/basic_05_c3_utf8.t57
-rw-r--r--t/mro/basic_05_dfs_utf8.t58
-rw-r--r--t/mro/basic_utf8.t328
-rw-r--r--t/mro/c3_with_overload_utf8.t47
-rw-r--r--t/mro/complex_c3_utf8.t144
-rw-r--r--t/mro/complex_dfs_utf8.t139
-rw-r--r--t/mro/dbic_c3_utf8.t121
-rw-r--r--t/mro/dbic_dfs_utf8.t121
-rw-r--r--t/mro/inconsistent_c3_utf8.t52
-rw-r--r--t/mro/isa_aliases_utf8.t46
-rw-r--r--t/mro/isa_c3_utf8.t71
-rw-r--r--t/mro/isa_dfs_utf8.t67
-rw-r--r--t/mro/isarev_utf8.t150
-rw-r--r--t/mro/method_caching_utf8.t67
-rw-r--r--t/mro/next_NEXT_utf8.t50
-rw-r--r--t/mro/next_edgecases_utf8.t98
-rw-r--r--t/mro/next_goto_utf8.t36
-rw-r--r--t/mro/next_inanon_utf8.t58
-rw-r--r--t/mro/next_ineval_utf8.t46
-rw-r--r--t/mro/next_method_utf8.t67
-rw-r--r--t/mro/next_skip_utf8.t80
-rw-r--r--t/mro/overload_c3_utf8.t57
-rw-r--r--t/mro/package_aliases_utf8.t468
-rw-r--r--t/mro/pkg_gen_utf8.t44
-rw-r--r--t/mro/recursion_c3_utf8.t102
-rw-r--r--t/mro/recursion_dfs_utf8.t89
-rw-r--r--t/mro/vulcan_c3_utf8.t67
-rw-r--r--t/mro/vulcan_dfs_utf8.t68
36 files changed, 3408 insertions, 0 deletions
diff --git a/t/mro/basic_01_c3_utf8.t b/t/mro/basic_01_c3_utf8.t
new file mode 100644
index 0000000000..952125b5c3
--- /dev/null
+++ b/t/mro/basic_01_c3_utf8.t
@@ -0,0 +1,49 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 4);
+
+=pod
+
+This tests the classic diamond inheritance pattern.
+
+ <A>
+ / \
+<B> <C>
+ \ /
+ <D>
+
+=cut
+
+{
+ package Diᚪၚd_A;
+ sub hèllò { 'Diᚪၚd_A::hèllò' }
+}
+{
+ package Diᚪၚd_B;
+ use base 'Diᚪၚd_A';
+}
+{
+ package Diᚪၚd_C;
+ use base 'Diᚪၚd_A';
+
+ sub hèllò { 'Diᚪၚd_C::hèllò' }
+}
+{
+ package Diᚪၚd_D;
+ use base ('Diᚪၚd_B', 'Diᚪၚd_C');
+ use mro 'c3';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Diᚪၚd_D'),
+ [ qw(Diᚪၚd_D Diᚪၚd_B Diᚪၚd_C Diᚪၚd_A) ]
+), '... got the right MRO for Diᚪၚd_D');
+
+is(Diᚪၚd_D->hèllò, 'Diᚪၚd_C::hèllò', '... method resolved itself as expected');
+is(Diᚪၚd_D->can('hèllò')->(), 'Diᚪၚd_C::hèllò', '... can(method) resolved itself as expected');
+is(UNIVERSAL::can("Diᚪၚd_D", 'hèllò')->(), 'Diᚪၚd_C::hèllò', '... can(method) resolved itself as expected');
diff --git a/t/mro/basic_01_dfs_utf8.t b/t/mro/basic_01_dfs_utf8.t
new file mode 100644
index 0000000000..b122aba8d4
--- /dev/null
+++ b/t/mro/basic_01_dfs_utf8.t
@@ -0,0 +1,49 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 4);
+
+=pod
+
+This tests the classic diamond inheritance pattern.
+
+ <A>
+ / \
+<B> <C>
+ \ /
+ <D>
+
+=cut
+
+{
+ package Diᚪၚd_A;
+ sub hèllò { 'Diᚪၚd_A::hèllò' }
+}
+{
+ package Diᚪၚd_B;
+ use base 'Diᚪၚd_A';
+}
+{
+ package Diᚪၚd_C;
+ use base 'Diᚪၚd_A';
+
+ sub hèllò { 'Diᚪၚd_C::hèllò' }
+}
+{
+ package Diᚪၚd_D;
+ use base ('Diᚪၚd_B', 'Diᚪၚd_C');
+ use mro 'dfs';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Diᚪၚd_D'),
+ [ qw(Diᚪၚd_D Diᚪၚd_B Diᚪၚd_A Diᚪၚd_C) ]
+), '... got the right MRO for Diᚪၚd_D');
+
+is(Diᚪၚd_D->hèllò, 'Diᚪၚd_A::hèllò', '... method resolved itself as expected');
+is(Diᚪၚd_D->can('hèllò')->(), 'Diᚪၚd_A::hèllò', '... can(method) resolved itself as expected');
+is(UNIVERSAL::can("Diᚪၚd_D", 'hèllò')->(), 'Diᚪၚd_A::hèllò', '... can(method) resolved itself as expected');
diff --git a/t/mro/basic_02_c3_utf8.t b/t/mro/basic_02_c3_utf8.t
new file mode 100644
index 0000000000..1f66e3bfe3
--- /dev/null
+++ b/t/mro/basic_02_c3_utf8.t
@@ -0,0 +1,117 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 10);
+
+=pod
+
+This example is take from: http://www.python.org/2.3/mro.html
+
+"My first example"
+class O: pass
+class F(O): pass
+class E(O): pass
+class D(O): pass
+class C(D,F): pass
+class B(D,E): pass
+class A(B,C): pass
+
+
+ 6
+ ---
+Level 3 | O | (more general)
+ / --- \
+ / | \ |
+ / | \ |
+ / | \ |
+ --- --- --- |
+Level 2 3 | D | 4| E | | F | 5 |
+ --- --- --- |
+ \ \ _ / | |
+ \ / \ _ | |
+ \ / \ | |
+ --- --- |
+Level 1 1 | B | | C | 2 |
+ --- --- |
+ \ / |
+ \ / \ /
+ ---
+Level 0 0 | A | (more specialized)
+ ---
+
+=cut
+
+{
+ package 텟ţ::ᴼ;
+ use mro 'c3';
+
+ package 텟ţ::Ḟ;
+ use mro 'c3';
+ use base '텟ţ::ᴼ';
+
+ package 텟ţ::ऍ;
+ use base '텟ţ::ᴼ';
+ use mro 'c3';
+
+ sub ƈ_or_ऍ { '텟ţ::ऍ' }
+
+ package 텟ţ::Ḋ;
+ use mro 'c3';
+ use base '텟ţ::ᴼ';
+
+ sub ƈ_or_Ḋ { '텟ţ::Ḋ' }
+
+ package 텟ţ::ƈ;
+ use base ('텟ţ::Ḋ', '텟ţ::Ḟ');
+ use mro 'c3';
+
+ sub ƈ_or_Ḋ { '텟ţ::ƈ' }
+ sub ƈ_or_ऍ { '텟ţ::ƈ' }
+
+ package 텟ţ::ᛒ;
+ use mro 'c3';
+ use base ('텟ţ::Ḋ', '텟ţ::ऍ');
+
+ package 텟ţ::ଅ;
+ use base ('텟ţ::ᛒ', '텟ţ::ƈ');
+ use mro 'c3';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::Ḟ'),
+ [ qw(텟ţ::Ḟ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::Ḟ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ऍ'),
+ [ qw(텟ţ::ऍ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::ऍ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::Ḋ'),
+ [ qw(텟ţ::Ḋ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::Ḋ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ƈ'),
+ [ qw(텟ţ::ƈ 텟ţ::Ḋ 텟ţ::Ḟ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::ƈ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ᛒ'),
+ [ qw(텟ţ::ᛒ 텟ţ::Ḋ 텟ţ::ऍ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::ᛒ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ଅ'),
+ [ qw(텟ţ::ଅ 텟ţ::ᛒ 텟ţ::ƈ 텟ţ::Ḋ 텟ţ::ऍ 텟ţ::Ḟ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::ଅ');
+
+is(텟ţ::ଅ->ƈ_or_Ḋ, '텟ţ::ƈ', '... got the expected method output');
+is(텟ţ::ଅ->can('ƈ_or_Ḋ')->(), '텟ţ::ƈ', '... can got the expected method output');
+is(텟ţ::ଅ->ƈ_or_ऍ, '텟ţ::ƈ', '... got the expected method output');
+is(텟ţ::ଅ->can('ƈ_or_ऍ')->(), '텟ţ::ƈ', '... can got the expected method output');
diff --git a/t/mro/basic_02_dfs_utf8.t b/t/mro/basic_02_dfs_utf8.t
new file mode 100644
index 0000000000..77d7d71193
--- /dev/null
+++ b/t/mro/basic_02_dfs_utf8.t
@@ -0,0 +1,117 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 10);
+
+=pod
+
+This example is take from: http://www.python.org/2.3/mro.html
+
+"My first example"
+class O: pass
+class F(O): pass
+class E(O): pass
+class D(O): pass
+class C(D,F): pass
+class B(D,E): pass
+class A(B,C): pass
+
+
+ 6
+ ---
+Level 3 | O | (more general)
+ / --- \
+ / | \ |
+ / | \ |
+ / | \ |
+ --- --- --- |
+Level 2 3 | D | 4| E | | F | 5 |
+ --- --- --- |
+ \ \ _ / | |
+ \ / \ _ | |
+ \ / \ | |
+ --- --- |
+Level 1 1 | B | | C | 2 |
+ --- --- |
+ \ / |
+ \ / \ /
+ ---
+Level 0 0 | A | (more specialized)
+ ---
+
+=cut
+
+{
+ package 텟ţ::ᴼ;
+ use mro 'dfs';
+
+ package 텟ţ::Ḟ;
+ use mro 'dfs';
+ use base '텟ţ::ᴼ';
+
+ package 텟ţ::ऍ;
+ use base '텟ţ::ᴼ';
+ use mro 'dfs';
+
+ sub ƈ_or_ऍ { '텟ţ::ऍ' }
+
+ package 텟ţ::Ḋ;
+ use mro 'dfs';
+ use base '텟ţ::ᴼ';
+
+ sub ƈ_or_Ḋ { '텟ţ::Ḋ' }
+
+ package 텟ţ::ƈ;
+ use base ('텟ţ::Ḋ', '텟ţ::Ḟ');
+ use mro 'dfs';
+
+ sub ƈ_or_Ḋ { '텟ţ::ƈ' }
+ sub ƈ_or_ऍ { '텟ţ::ƈ' }
+
+ package 텟ţ::ᛒ;
+ use mro 'dfs';
+ use base ('텟ţ::Ḋ', '텟ţ::ऍ');
+
+ package 텟ţ::ଅ;
+ use base ('텟ţ::ᛒ', '텟ţ::ƈ');
+ use mro 'dfs';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::Ḟ'),
+ [ qw(텟ţ::Ḟ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::Ḟ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ऍ'),
+ [ qw(텟ţ::ऍ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::ऍ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::Ḋ'),
+ [ qw(텟ţ::Ḋ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::Ḋ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ƈ'),
+ [ qw(텟ţ::ƈ 텟ţ::Ḋ 텟ţ::ᴼ 텟ţ::Ḟ) ]
+), '... got the right MRO for 텟ţ::ƈ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ᛒ'),
+ [ qw(텟ţ::ᛒ 텟ţ::Ḋ 텟ţ::ᴼ 텟ţ::ऍ) ]
+), '... got the right MRO for 텟ţ::ᛒ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ଅ'),
+ [ qw(텟ţ::ଅ 텟ţ::ᛒ 텟ţ::Ḋ 텟ţ::ᴼ 텟ţ::ऍ 텟ţ::ƈ 텟ţ::Ḟ) ]
+), '... got the right MRO for 텟ţ::ଅ');
+
+is(텟ţ::ଅ->ƈ_or_Ḋ, '텟ţ::Ḋ', '... got the expected method output');
+is(텟ţ::ଅ->can('ƈ_or_Ḋ')->(), '텟ţ::Ḋ', '... can got the expected method output');
+is(텟ţ::ଅ->ƈ_or_ऍ, '텟ţ::ऍ', '... got the expected method output');
+is(텟ţ::ଅ->can('ƈ_or_ऍ')->(), '텟ţ::ऍ', '... can got the expected method output');
diff --git a/t/mro/basic_03_c3_utf8.t b/t/mro/basic_03_c3_utf8.t
new file mode 100644
index 0000000000..7e417a27c3
--- /dev/null
+++ b/t/mro/basic_03_c3_utf8.t
@@ -0,0 +1,103 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 4);
+
+=pod
+
+This example is take from: http://www.python.org/2.3/mro.html
+
+"My second example"
+class O: pass
+class F(O): pass
+class E(O): pass
+class D(O): pass
+class C(D,F): pass
+class B(E,D): pass
+class A(B,C): pass
+
+ 6
+ ---
+Level 3 | O |
+ / --- \
+ / | \
+ / | \
+ / | \
+ --- --- ---
+Level 2 2 | E | 4 | D | | F | 5
+ --- --- ---
+ \ / \ /
+ \ / \ /
+ \ / \ /
+ --- ---
+Level 1 1 | B | | C | 3
+ --- ---
+ \ /
+ \ /
+ ---
+Level 0 0 | A |
+ ---
+
+>>> A.mro()
+(<class '__main__.A'>, <class '__main__.B'>, <class '__main__.E'>,
+<class '__main__.C'>, <class '__main__.D'>, <class '__main__.F'>,
+<type 'object'>)
+
+=cut
+
+{
+ package 텟ţ::ᴼ;
+ use mro 'c3';
+
+ sub ᴼ_or_Ḋ { '텟ţ::ᴼ' }
+ sub ᴼ_or_Ḟ { '텟ţ::ᴼ' }
+
+ package 텟ţ::Ḟ;
+ use base '텟ţ::ᴼ';
+ use mro 'c3';
+
+ sub ᴼ_or_Ḟ { '텟ţ::Ḟ' }
+
+ package 텟ţ::ऍ;
+ use base '텟ţ::ᴼ';
+ use mro 'c3';
+
+ package 텟ţ::Ḋ;
+ use base '텟ţ::ᴼ';
+ use mro 'c3';
+
+ sub ᴼ_or_Ḋ { '텟ţ::Ḋ' }
+ sub ƈ_or_Ḋ { '텟ţ::Ḋ' }
+
+ package 텟ţ::ƈ;
+ use base ('텟ţ::Ḋ', '텟ţ::Ḟ');
+ use mro 'c3';
+
+ sub ƈ_or_Ḋ { '텟ţ::ƈ' }
+
+ package 텟ţ::ᛒ;
+ use base ('텟ţ::ऍ', '텟ţ::Ḋ');
+ use mro 'c3';
+
+ package 텟ţ::ଅ;
+ use base ('텟ţ::ᛒ', '텟ţ::ƈ');
+ use mro 'c3';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ଅ'),
+ [ qw(텟ţ::ଅ 텟ţ::ᛒ 텟ţ::ऍ 텟ţ::ƈ 텟ţ::Ḋ 텟ţ::Ḟ 텟ţ::ᴼ) ]
+), '... got the right MRO for 텟ţ::ଅ');
+
+is(텟ţ::ଅ->ᴼ_or_Ḋ, '텟ţ::Ḋ', '... got the right method dispatch');
+is(텟ţ::ଅ->ᴼ_or_Ḟ, '텟ţ::Ḟ', '... got the right method dispatch');
+
+# NOTE:
+# this test is particularly interesting because the p5 dispatch
+# would actually call 텟ţ::Ḋ before 텟ţ::ƈ and 텟ţ::Ḋ is a
+# subclass of 텟ţ::ƈ
+is(텟ţ::ଅ->ƈ_or_Ḋ, '텟ţ::ƈ', '... got the right method dispatch');
diff --git a/t/mro/basic_03_dfs_utf8.t b/t/mro/basic_03_dfs_utf8.t
new file mode 100644
index 0000000000..69e57be4f7
--- /dev/null
+++ b/t/mro/basic_03_dfs_utf8.t
@@ -0,0 +1,103 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 4);
+
+=pod
+
+This example is take from: http://www.python.org/2.3/mro.html
+
+"My second example"
+class O: pass
+class F(O): pass
+class E(O): pass
+class D(O): pass
+class C(D,F): pass
+class B(E,D): pass
+class A(B,C): pass
+
+ 6
+ ---
+Level 3 | O |
+ / --- \
+ / | \
+ / | \
+ / | \
+ --- --- ---
+Level 2 2 | E | 4 | D | | F | 5
+ --- --- ---
+ \ / \ /
+ \ / \ /
+ \ / \ /
+ --- ---
+Level 1 1 | B | | C | 3
+ --- ---
+ \ /
+ \ /
+ ---
+Level 0 0 | A |
+ ---
+
+>>> A.mro()
+(<class '__main__.A'>, <class '__main__.B'>, <class '__main__.E'>,
+<class '__main__.C'>, <class '__main__.D'>, <class '__main__.F'>,
+<type 'object'>)
+
+=cut
+
+{
+ package 텟ţ::ᴼ;
+ use mro 'dfs';
+
+ sub ᴼ_or_Ḋ { '텟ţ::ᴼ' }
+ sub ᴼ_or_Ḟ { '텟ţ::ᴼ' }
+
+ package 텟ţ::Ḟ;
+ use base '텟ţ::ᴼ';
+ use mro 'dfs';
+
+ sub ᴼ_or_Ḟ { '텟ţ::Ḟ' }
+
+ package 텟ţ::ऍ;
+ use base '텟ţ::ᴼ';
+ use mro 'dfs';
+
+ package 텟ţ::Ḋ;
+ use base '텟ţ::ᴼ';
+ use mro 'dfs';
+
+ sub ᴼ_or_Ḋ { '텟ţ::Ḋ' }
+ sub ƈ_or_Ḋ { '텟ţ::Ḋ' }
+
+ package 텟ţ::ƈ;
+ use base ('텟ţ::Ḋ', '텟ţ::Ḟ');
+ use mro 'dfs';
+
+ sub ƈ_or_Ḋ { '텟ţ::ƈ' }
+
+ package 텟ţ::ᛒ;
+ use base ('텟ţ::ऍ', '텟ţ::Ḋ');
+ use mro 'dfs';
+
+ package 텟ţ::ଅ;
+ use base ('텟ţ::ᛒ', '텟ţ::ƈ');
+ use mro 'dfs';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('텟ţ::ଅ'),
+ [ qw(텟ţ::ଅ 텟ţ::ᛒ 텟ţ::ऍ 텟ţ::ᴼ 텟ţ::Ḋ 텟ţ::ƈ 텟ţ::Ḟ) ]
+), '... got the right MRO for 텟ţ::ଅ');
+
+is(텟ţ::ଅ->ᴼ_or_Ḋ, '텟ţ::ᴼ', '... got the right method dispatch');
+is(텟ţ::ଅ->ᴼ_or_Ḟ, '텟ţ::ᴼ', '... got the right method dispatch');
+
+# NOTE:
+# this test is particularly interesting because the p5 dispatch
+# would actually call 텟ţ::Ḋ before 텟ţ::ƈ and 텟ţ::Ḋ is a
+# subclass of 텟ţ::ƈ
+is(텟ţ::ଅ->ƈ_or_Ḋ, '텟ţ::Ḋ', '... got the right method dispatch');
diff --git a/t/mro/basic_04_c3_utf8.t b/t/mro/basic_04_c3_utf8.t
new file mode 100644
index 0000000000..3665ca6b0d
--- /dev/null
+++ b/t/mro/basic_04_c3_utf8.t
@@ -0,0 +1,36 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 1);
+
+=pod
+
+From the parrot test t/pmc/object-meths.t
+
+ A B A E
+ \ / \ /
+ C D
+ \ /
+ \ /
+ F
+
+=cut
+
+{
+ package Ƭ::ŁiƁ::ଅ; use mro 'c3';
+ package Ƭ::ŁiƁ::ᛒ; use mro 'c3';
+ package Ƭ::ŁiƁ::ऍ; use mro 'c3';
+ package Ƭ::ŁiƁ::ƈ; use mro 'c3'; use base ('Ƭ::ŁiƁ::ଅ', 'Ƭ::ŁiƁ::ᛒ');
+ package Ƭ::ŁiƁ::Ḋ; use mro 'c3'; use base ('Ƭ::ŁiƁ::ଅ', 'Ƭ::ŁiƁ::ऍ');
+ package Ƭ::ŁiƁ::Ḟ; use mro 'c3'; use base ('Ƭ::ŁiƁ::ƈ', 'Ƭ::ŁiƁ::Ḋ');
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Ƭ::ŁiƁ::Ḟ'),
+ [ qw(Ƭ::ŁiƁ::Ḟ Ƭ::ŁiƁ::ƈ Ƭ::ŁiƁ::Ḋ Ƭ::ŁiƁ::ଅ Ƭ::ŁiƁ::ᛒ Ƭ::ŁiƁ::ऍ) ]
+), '... got the right MRO for Ƭ::ŁiƁ::Ḟ');
+
diff --git a/t/mro/basic_04_dfs_utf8.t b/t/mro/basic_04_dfs_utf8.t
new file mode 100644
index 0000000000..69dc8ef20e
--- /dev/null
+++ b/t/mro/basic_04_dfs_utf8.t
@@ -0,0 +1,36 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 1);
+
+=pod
+
+From the parrot test t/pmc/object-meths.t
+
+ ଅ ᛒ ଅ ऍ
+ \ / \ /
+ ƈ Ḋ
+ \ /
+ \ /
+ Ḟ
+
+=cut
+
+{
+ package Ƭ::ŁiƁ::ଅ; use mro 'dfs';
+ package Ƭ::ŁiƁ::ᛒ; use mro 'dfs';
+ package Ƭ::ŁiƁ::ऍ; use mro 'dfs';
+ package Ƭ::ŁiƁ::ƈ; use mro 'dfs'; use base ('Ƭ::ŁiƁ::ଅ', 'Ƭ::ŁiƁ::ᛒ');
+ package Ƭ::ŁiƁ::Ḋ; use mro 'dfs'; use base ('Ƭ::ŁiƁ::ଅ', 'Ƭ::ŁiƁ::ऍ');
+ package Ƭ::ŁiƁ::Ḟ; use mro 'dfs'; use base ('Ƭ::ŁiƁ::ƈ', 'Ƭ::ŁiƁ::Ḋ');
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Ƭ::ŁiƁ::Ḟ'),
+ [ qw(Ƭ::ŁiƁ::Ḟ Ƭ::ŁiƁ::ƈ Ƭ::ŁiƁ::ଅ Ƭ::ŁiƁ::ᛒ Ƭ::ŁiƁ::Ḋ Ƭ::ŁiƁ::ऍ) ]
+), '... got the right MRO for Ƭ::ŁiƁ::Ḟ');
+
diff --git a/t/mro/basic_05_c3_utf8.t b/t/mro/basic_05_c3_utf8.t
new file mode 100644
index 0000000000..a295c963c0
--- /dev/null
+++ b/t/mro/basic_05_c3_utf8.t
@@ -0,0 +1,57 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 2);
+
+=pod
+
+This tests a strange bug found by Matt S. Trout
+while building DBIx::Class. Thanks Matt!!!!
+
+ <A>
+ / \
+<C> <B>
+ \ /
+ <D>
+
+=cut
+
+{
+ package Diᚪၚd_A;
+ use mro 'c3';
+
+ sub ᕘ { 'Diᚪၚd_A::ᕘ' }
+}
+{
+ package Diᚪၚd_B;
+ use base 'Diᚪၚd_A';
+ use mro 'c3';
+
+ sub ᕘ { 'Diᚪၚd_B::ᕘ => ' . (shift)->SUPER::ᕘ }
+}
+{
+ package Diᚪၚd_C;
+ use mro 'c3';
+ use base 'Diᚪၚd_A';
+
+}
+{
+ package Diᚪၚd_D;
+ use base ('Diᚪၚd_C', 'Diᚪၚd_B');
+ use mro 'c3';
+
+ sub ᕘ { 'Diᚪၚd_D::ᕘ => ' . (shift)->SUPER::ᕘ }
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Diᚪၚd_D'),
+ [ qw(Diᚪၚd_D Diᚪၚd_C Diᚪၚd_B Diᚪၚd_A) ]
+), '... got the right MRO for Diᚪၚd_D');
+
+is(Diᚪၚd_D->ᕘ,
+ 'Diᚪၚd_D::ᕘ => Diᚪၚd_B::ᕘ => Diᚪၚd_A::ᕘ',
+ '... got the right next::method dispatch path');
diff --git a/t/mro/basic_05_dfs_utf8.t b/t/mro/basic_05_dfs_utf8.t
new file mode 100644
index 0000000000..452d1dbdc3
--- /dev/null
+++ b/t/mro/basic_05_dfs_utf8.t
@@ -0,0 +1,58 @@
+#!./perl
+
+use strict;
+use warnings;
+
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 2);
+
+=pod
+
+This tests a strange bug found by Matt S. Trout
+while building DBIx::Class. Thanks Matt!!!!
+
+ <A>
+ / \
+<C> <B>
+ \ /
+ <D>
+
+=cut
+
+{
+ package Diᚪၚd_A;
+ use mro 'dfs';
+
+ sub ᕘ { 'Diᚪၚd_A::ᕘ' }
+}
+{
+ package Diᚪၚd_B;
+ use base 'Diᚪၚd_A';
+ use mro 'dfs';
+
+ sub ᕘ { 'Diᚪၚd_B::ᕘ => ' . (shift)->SUPER::ᕘ }
+}
+{
+ package Diᚪၚd_C;
+ use mro 'dfs';
+ use base 'Diᚪၚd_A';
+
+}
+{
+ package Diᚪၚd_D;
+ use base ('Diᚪၚd_C', 'Diᚪၚd_B');
+ use mro 'dfs';
+
+ sub ᕘ { 'Diᚪၚd_D::ᕘ => ' . (shift)->SUPER::ᕘ }
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Diᚪၚd_D'),
+ [ qw(Diᚪၚd_D Diᚪၚd_C Diᚪၚd_A Diᚪၚd_B) ]
+), '... got the right MRO for Diᚪၚd_D');
+
+is(Diᚪၚd_D->ᕘ,
+ 'Diᚪၚd_D::ᕘ => Diᚪၚd_A::ᕘ',
+ '... got the right next::method dispatch path');
diff --git a/t/mro/basic_utf8.t b/t/mro/basic_utf8.t
new file mode 100644
index 0000000000..d0dff50fe2
--- /dev/null
+++ b/t/mro/basic_utf8.t
@@ -0,0 +1,328 @@
+#!./perl
+
+use utf8;
+use open qw( :utf8 :std );
+use strict;
+use warnings;
+
+BEGIN { require q(./test.pl); } plan(tests => 53);
+
+require mro;
+
+{
+ package MRO_அ;
+ our @ISA = qw//;
+ package MRO_ɓ;
+ our @ISA = qw//;
+ package MRO_ᶝ;
+ our @ISA = qw//;
+ package MRO_d;
+ our @ISA = qw/MRO_அ MRO_ɓ MRO_ᶝ/;
+ package MRO_ɛ;
+ our @ISA = qw/MRO_அ MRO_ɓ MRO_ᶝ/;
+ package MRO_ᚠ;
+ our @ISA = qw/MRO_d MRO_ɛ/;
+}
+
+my @MFO_ᚠ_DFS = qw/MRO_ᚠ MRO_d MRO_அ MRO_ɓ MRO_ᶝ MRO_ɛ/;
+my @MFO_ᚠ_C3 = qw/MRO_ᚠ MRO_d MRO_ɛ MRO_அ MRO_ɓ MRO_ᶝ/;
+is(mro::get_mro('MRO_ᚠ'), 'dfs');
+ok(eq_array(
+ mro::get_linear_isa('MRO_ᚠ'), \@MFO_ᚠ_DFS
+));
+
+ok(eq_array(mro::get_linear_isa('MRO_ᚠ', 'dfs'), \@MFO_ᚠ_DFS));
+ok(eq_array(mro::get_linear_isa('MRO_ᚠ', 'c3'), \@MFO_ᚠ_C3));
+eval{mro::get_linear_isa('MRO_ᚠ', 'C3')};
+like($@, qr/^Invalid mro name: 'C3'/);
+
+mro::set_mro('MRO_ᚠ', 'c3');
+is(mro::get_mro('MRO_ᚠ'), 'c3');
+ok(eq_array(
+ mro::get_linear_isa('MRO_ᚠ'), \@MFO_ᚠ_C3
+));
+
+ok(eq_array(mro::get_linear_isa('MRO_ᚠ', 'dfs'), \@MFO_ᚠ_DFS));
+ok(eq_array(mro::get_linear_isa('MRO_ᚠ', 'c3'), \@MFO_ᚠ_C3));
+eval{mro::get_linear_isa('MRO_ᚠ', 'C3')};
+like($@, qr/^Invalid mro name: 'C3'/);
+
+ok(!mro::is_universal('MRO_ɓ'));
+
+@UNIVERSAL::ISA = qw/MRO_ᚠ/;
+ok(mro::is_universal('MRO_ɓ'));
+
+@UNIVERSAL::ISA = ();
+ok(!mro::is_universal('MRO_ᚠ'));
+ok(!mro::is_universal('MRO_ɓ'));
+
+# is_universal, get_mro, and get_linear_isa should
+# handle non-existent packages sanely
+ok(!mro::is_universal('Does_Not_Exist'));
+is(mro::get_mro('Also_Does_Not_Exist'), 'dfs');
+ok(eq_array(
+ mro::get_linear_isa('Does_Not_Exist_Three'),
+ [qw/Does_Not_Exist_Three/]
+));
+
+# Assigning @ISA via globref
+{
+ package MRO_ҭṣṱबꗻ;
+ sub 텟tf운ꜿ { return 123 }
+ package MRO_Test옽ḦРꤷsӭ;
+ sub 텟ₜꖢᶯcƧ { return 321 }
+ package MRO_Ɯ; our @ISA = qw/MRO_ҭṣṱबꗻ/;
+}
+*MRO_ᕡ::ISA = *MRO_Ɯ::ISA;
+is(eval { MRO_ᕡ->텟tf운ꜿ() }, 123);
+
+# XXX TODO (when there's a way to backtrack through a glob's aliases)
+# push(@MRO_M::ISA, 'MRO_TestOtherBase');
+# is(eval { MRO_N->testfunctwo() }, 321);
+
+# Simple DESTROY Baseline
+{
+ my $x = 0;
+ my $obj;
+
+ {
+ package DESTROY_MRO_Bӓeᓕne;
+ sub new { bless {} => shift }
+ sub DESTROY { $x++ }
+
+ package DESTROY_MRO_Bӓeᓕne_χḻɖ;
+ our @ISA = qw/DESTROY_MRO_Bӓeᓕne/;
+ }
+
+ $obj = DESTROY_MRO_Bӓeᓕne->new();
+ undef $obj;
+ is($x, 1);
+
+ $obj = DESTROY_MRO_Bӓeᓕne_χḻɖ->new();
+ undef $obj;
+ is($x, 2);
+}
+
+# Dynamic DESTROY
+{
+ my $x = 0;
+ my $obj;
+
+ {
+ package DESTROY_MRO_Dჷ및;
+ sub new { bless {} => shift }
+
+ package DESTROY_MRO_Dჷ및_χḻɖ;
+ our @ISA = qw/DESTROY_MRO_Dჷ및/;
+ }
+
+ $obj = DESTROY_MRO_Dჷ및->new();
+ undef $obj;
+ is($x, 0);
+
+ $obj = DESTROY_MRO_Dჷ및_χḻɖ->new();
+ undef $obj;
+ is($x, 0);
+
+ no warnings 'once';
+ *DESTROY_MRO_Dჷ및::DESTROY = sub { $x++ };
+
+ $obj = DESTROY_MRO_Dჷ및->new();
+ undef $obj;
+ is($x, 1);
+
+ $obj = DESTROY_MRO_Dჷ및_χḻɖ->new();
+ undef $obj;
+ is($x, 2);
+}
+
+# clearing @ISA in different ways
+# some are destructive to the package, hence the new
+# package name each time
+{
+ no warnings 'uninitialized';
+ {
+ package ᛁ앛ଌᛠ;
+ our @ISA = qw/xx ƳƳ ƶƶ/;
+ }
+ # baseline
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ'),[qw/ᛁ앛ଌᛠ xx ƳƳ ƶƶ/]));
+
+ # this looks dumb, but it preserves existing behavior for compatibility
+ # (undefined @ISA elements treated as "main")
+ $ᛁ앛ଌᛠ::ISA[1] = undef;
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ'),[qw/ᛁ앛ଌᛠ xx main ƶƶ/]));
+
+ # undef the array itself
+ undef @ᛁ앛ଌᛠ::ISA;
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ'),[qw/ᛁ앛ଌᛠ/]));
+
+ # Now, clear more than one package's @ISA at once
+ {
+ package ᛁ앛ଌᛠ1;
+ our @ISA = qw/WẆ xx/;
+
+ package ᛁ앛ଌᛠ2;
+ our @ISA = qw/ƳƳ ƶƶ/;
+ }
+ # baseline
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ1'),[qw/ᛁ앛ଌᛠ1 WẆ xx/]));
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ2'),[qw/ᛁ앛ଌᛠ2 ƳƳ ƶƶ/]));
+ (@ᛁ앛ଌᛠ1::ISA, @ᛁ앛ଌᛠ2::ISA) = ();
+
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ1'),[qw/ᛁ앛ଌᛠ1/]));
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ2'),[qw/ᛁ앛ଌᛠ2/]));
+
+ # [perl #49564] This is a pretty obscure way of clearing @ISA but
+ # it tests a regression that affects XS code calling av_clear too.
+ {
+ package ᛁ앛ଌᛠ3;
+ our @ISA = qw/WẆ xx/;
+ }
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ3'),[qw/ᛁ앛ଌᛠ3 WẆ xx/]));
+ {
+ package ᛁ앛ଌᛠ3;
+ reset 'I';
+ }
+ ok(eq_array(mro::get_linear_isa('ᛁ앛ଌᛠ3'),[qw/ᛁ앛ଌᛠ3/]));
+}
+
+# Check that recursion bails out "cleanly" in a variety of cases
+# (as opposed to say, bombing the interpreter or something)
+{
+ my @recurse_codes = (
+ '@MRO_ഋ1::ISA = "MRO_ഋ2"; @MRO_ഋ2::ISA = "MRO_ഋ1";',
+ '@MRO_ഋ3::ISA = "MRO_ഋ4"; push(@MRO_ഋ4::ISA, "MRO_ഋ3");',
+ '@MRO_ഋ5::ISA = "MRO_ഋ6"; @MRO_ഋ6::ISA = qw/xx MRO_ഋ5 ƳƳ/;',
+ '@MRO_ഋ7::ISA = "MRO_ഋ8"; push(@MRO_ഋ8::ISA, qw/xx MRO_ഋ7 ƳƳ/)',
+ );
+ foreach my $code (@recurse_codes) {
+ eval $code;
+ ok($@ =~ /Recursive inheritance detected/);
+ }
+}
+
+# Check that SUPER caches get invalidated correctly
+{
+ {
+ package スṔઍR텟ʇ;
+ sub new { bless {} => shift }
+ sub ຟઓ { $_[1]+1 }
+
+ package スṔઍR텟ʇ::MᶤƉ;
+ our @ISA = 'スṔઍR텟ʇ';
+
+ package スṔઍR텟ʇ::킫;
+ our @ISA = 'スṔઍR텟ʇ::MᶤƉ';
+ sub ຟઓ { my $s = shift; $s->SUPER::ຟઓ(@_) }
+
+ package スṔઍR텟ʇ::렙ﷰए;
+ sub ຟઓ { $_[1]+3 }
+ }
+
+ my $stk_obj = スṔઍR텟ʇ::킫->new();
+ is($stk_obj->ຟઓ(1), 2);
+ { no warnings 'redefine';
+ *スṔઍR텟ʇ::ຟઓ = sub { $_[1]+2 };
+ }
+ is($stk_obj->ຟઓ(2), 4);
+ @スṔઍR텟ʇ::MᶤƉ::ISA = 'スṔઍR텟ʇ::렙ﷰए';
+ is($stk_obj->ຟઓ(3), 6);
+}
+
+{
+ {
+ # assigning @ISA via arrayref to globref RT 60220
+ package ᛔ1;
+ sub new { bless {}, shift }
+
+ package ᛔ2;
+ }
+ *{ᛔ2::ISA} = [ 'ᛔ1' ];
+ my $foo = ᛔ2->new;
+ ok(!eval { $foo->ɓᛅƘ }, "no ɓᛅƘ method");
+ no warnings 'once'; # otherwise it'll bark about ᛔ1::ɓᛅƘ used only once
+ *{ᛔ1::ɓᛅƘ} = sub { "[ɓᛅƘ]" };
+ is(scalar eval { $foo->ɓᛅƘ }, "[ɓᛅƘ]", "can ɓᛅƘ now");
+ is $@, '';
+}
+
+{
+ # assigning @ISA via arrayref then modifying it RT 72866
+ {
+ package ㄑ1;
+ sub Fஓ { }
+
+ package ㄑ2;
+ sub ƚ { }
+
+ package ㄑ3;
+ }
+ push @ㄑ3::ISA, "ㄑ1";
+ can_ok("ㄑ3", "Fஓ");
+ *ㄑ3::ISA = [];
+ push @ㄑ3::ISA, "ㄑ1";
+ can_ok("ㄑ3", "Fஓ");
+ *ㄑ3::ISA = [];
+ push @ㄑ3::ISA, "ㄑ2";
+ can_ok("ㄑ3", "ƚ");
+ ok(!ㄑ3->can("Fஓ"), "can't call Fஓ method any longer");
+}
+
+{
+ # test mro::method_changed_in
+ my $count = mro::get_pkg_gen("MRO_அ");
+ mro::method_changed_in("MRO_அ");
+ my $count_new = mro::get_pkg_gen("MRO_அ");
+
+ is($count_new, $count + 1);
+}
+
+{
+ # test if we can call mro::invalidate_all_method_caches;
+ eval {
+ mro::invalidate_all_method_caches();
+ };
+ is($@, "");
+}
+
+{
+ # @main::ISA
+ no warnings 'once';
+ @main::ISA = 'პᛅeȵᛏ';
+ my $output = '';
+ *პᛅeȵᛏ::ど = sub { $output .= 'პᛅeȵᛏ' };
+ *პᛅeȵᛏ2::ど = sub { $output .= 'პᛅeȵᛏ2' };
+ main->ど;
+ @main::ISA = 'პᛅeȵᛏ2';
+ main->ど;
+ is $output, 'პᛅeȵᛏპᛅeȵᛏ2', '@main::ISA is magical';
+}
+
+{
+ # Undefining *ISA, then modifying @ISA
+ # This broke Class::Trait. See [perl #79024].
+ {package Class::Trait::Base}
+ no strict 'refs';
+ undef *{"एxṰர::ʦፖㄡsȨ::ISA"};
+ 'एxṰர::ʦፖㄡsȨ'->isa('Class::Trait::Base'); # cache the mro
+ unshift @{"एxṰர::ʦፖㄡsȨ::ISA"}, 'Class::Trait::Base';
+ ok 'एxṰர::ʦፖㄡsȨ'->isa('Class::Trait::Base'),
+ 'a isa b after undef *a::ISA and @a::ISA modification';
+}
+
+{
+ # Deleting $package::{ISA}
+ # Broken in 5.10.0; fixed in 5.13.7
+ @BḼᵑth::ISA = 'Bલdḏ';
+ delete $BḼᵑth::{ISA};
+ ok !BḼᵑth->isa("Bલdḏ"), 'delete $package::{ISA}';
+}
+
+{
+ # Undefining stashes
+ @ᖫᕃㄒṭ::ISA = "ᖮw잍";
+ @ᖮw잍::ISA = "ሲঌએ";
+ undef %ᖮw잍::;
+ ok !ᖫᕃㄒṭ->isa('ሲঌએ'), 'undef %package:: updates subclasses';
+}
diff --git a/t/mro/c3_with_overload_utf8.t b/t/mro/c3_with_overload_utf8.t
new file mode 100644
index 0000000000..498ce2f613
--- /dev/null
+++ b/t/mro/c3_with_overload_utf8.t
@@ -0,0 +1,47 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+require q(./test.pl); plan(tests => 7);
+
+{
+ package BaseTest;
+ use strict;
+ use warnings;
+ use mro 'c3';
+
+ package OverloadingTest;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ use base 'BaseTest';
+ use overload '""' => sub { ref(shift) . " stringified" },
+ fallback => 1;
+
+ sub new { bless {} => shift }
+
+ package InheritingFromOverloadedTest;
+ use strict;
+ use warnings;
+ use base 'OverloadingTest';
+ use mro 'c3';
+}
+
+my $x = InheritingFromOverloadedTest->new();
+isa_ok($x, 'InheritingFromOverloadedTest');
+
+my $y = OverloadingTest->new();
+isa_ok($y, 'OverloadingTest');
+
+is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value when stringifing');
+is("$y", 'OverloadingTest stringified', '... got the right value when stringifing');
+
+ok(($y eq 'OverloadingTest stringified'), '... eq was handled correctly');
+
+my $result;
+eval {
+ $result = $x eq 'InheritingFromOverloadedTest stringified'
+};
+ok(!$@, '... this should not throw an exception');
+ok($result, '... and we should get the true value');
diff --git a/t/mro/complex_c3_utf8.t b/t/mro/complex_c3_utf8.t
new file mode 100644
index 0000000000..b7ffca5e14
--- /dev/null
+++ b/t/mro/complex_c3_utf8.t
@@ -0,0 +1,144 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 12);
+
+=pod
+
+This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879
+
+ --- --- ---
+Level 5 8 | A | 9 | B | A | C | (More General)
+ --- --- --- V
+ \ | / |
+ \ | / |
+ \ | / |
+ \ | / |
+ --- |
+Level 4 7 | D | |
+ --- |
+ / \ |
+ / \ |
+ --- --- |
+Level 3 4 | G | 6 | E | |
+ --- --- |
+ | | |
+ | | |
+ --- --- |
+Level 2 3 | H | 5 | F | |
+ --- --- |
+ \ / | |
+ \ / | |
+ \ | |
+ / \ | |
+ / \ | |
+ --- --- |
+Level 1 1 | J | 2 | I | |
+ --- --- |
+ \ / |
+ \ / |
+ --- v
+Level 0 0 | K | (More Specialized)
+ ---
+
+
+0123456789A
+KJIHGFEDABC
+
+=cut
+
+{
+ package 텟Ṱ::ᐊ; use mro 'c3';
+
+ package 텟Ṱ::ḅ; use mro 'c3';
+
+ package 텟Ṱ::ȼ; use mro 'c3';
+
+ package 텟Ṱ::Ḏ; use mro 'c3';
+ use base qw/텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ/;
+
+ package 텟Ṱ::Ӭ; use mro 'c3';
+ use base qw/텟Ṱ::Ḏ/;
+
+ package 텟Ṱ::Ḟ; use mro 'c3';
+ use base qw/텟Ṱ::Ӭ/;
+ sub testmèth { "wrong" }
+
+ package 텟Ṱ::ḡ; use mro 'c3';
+ use base qw/텟Ṱ::Ḏ/;
+
+ package 텟Ṱ::Ḣ; use mro 'c3';
+ use base qw/텟Ṱ::ḡ/;
+
+ package 텟Ṱ::ᶦ; use mro 'c3';
+ use base qw/텟Ṱ::Ḣ 텟Ṱ::Ḟ/;
+ sub testmèth { "right" }
+
+ package 텟Ṱ::J; use mro 'c3';
+ use base qw/텟Ṱ::Ḟ/;
+
+ package 텟Ṱ::Ḵ; use mro 'c3';
+ use base qw/텟Ṱ::J 텟Ṱ::ᶦ/;
+ sub testmèth { shift->next::method }
+}
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ᐊ'),
+ [ qw(텟Ṱ::ᐊ) ]
+), '... got the right C3 merge order for 텟Ṱ::ᐊ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ḅ'),
+ [ qw(텟Ṱ::ḅ) ]
+), '... got the right C3 merge order for 텟Ṱ::ḅ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ȼ'),
+ [ qw(텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::ȼ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḏ'),
+ [ qw(텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::Ḏ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ӭ'),
+ [ qw(텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::Ӭ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḟ'),
+ [ qw(텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::Ḟ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ḡ'),
+ [ qw(텟Ṱ::ḡ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::ḡ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḣ'),
+ [ qw(텟Ṱ::Ḣ 텟Ṱ::ḡ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::Ḣ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ᶦ'),
+ [ qw(텟Ṱ::ᶦ 텟Ṱ::Ḣ 텟Ṱ::ḡ 텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::ᶦ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::J'),
+ [ qw(텟Ṱ::J 텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::J');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḵ'),
+ [ qw(텟Ṱ::Ḵ 텟Ṱ::J 텟Ṱ::ᶦ 텟Ṱ::Ḣ 텟Ṱ::ḡ 텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right C3 merge order for 텟Ṱ::Ḵ');
+
+is(텟Ṱ::Ḵ->testmèth(), "right", 'next::method working ok');
diff --git a/t/mro/complex_dfs_utf8.t b/t/mro/complex_dfs_utf8.t
new file mode 100644
index 0000000000..723af14143
--- /dev/null
+++ b/t/mro/complex_dfs_utf8.t
@@ -0,0 +1,139 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 11);
+
+=pod
+
+This example is taken from: http://rt.cpan.org/Public/Bug/Display.html?id=20879
+
+ --- --- ---
+Level 5 8 | A | 9 | B | A | C | (More General)
+ --- --- --- V
+ \ | / |
+ \ | / |
+ \ | / |
+ \ | / |
+ --- |
+Level 4 7 | D | |
+ --- |
+ / \ |
+ / \ |
+ --- --- |
+Level 3 4 | G | 6 | E | |
+ --- --- |
+ | | |
+ | | |
+ --- --- |
+Level 2 3 | H | 5 | F | |
+ --- --- |
+ \ / | |
+ \ / | |
+ \ | |
+ / \ | |
+ / \ | |
+ --- --- |
+Level 1 1 | J | 2 | I | |
+ --- --- |
+ \ / |
+ \ / |
+ --- v
+Level 0 0 | K | (More Specialized)
+ ---
+
+
+0123456789A
+KJIHGFEDABC
+
+=cut
+
+{
+ package 텟Ṱ::ᐊ; use mro 'dfs';
+
+ package 텟Ṱ::ḅ; use mro 'dfs';
+
+ package 텟Ṱ::ȼ; use mro 'dfs';
+
+ package 텟Ṱ::Ḏ; use mro 'dfs';
+ use base qw/텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ/;
+
+ package 텟Ṱ::Ӭ; use mro 'dfs';
+ use base qw/텟Ṱ::Ḏ/;
+
+ package 텟Ṱ::Ḟ; use mro 'dfs';
+ use base qw/텟Ṱ::Ӭ/;
+
+ package 텟Ṱ::ḡ; use mro 'dfs';
+ use base qw/텟Ṱ::Ḏ/;
+
+ package 텟Ṱ::Ḣ; use mro 'dfs';
+ use base qw/텟Ṱ::ḡ/;
+
+ package 텟Ṱ::ᶦ; use mro 'dfs';
+ use base qw/텟Ṱ::Ḣ 텟Ṱ::Ḟ/;
+
+ package 텟Ṱ::J; use mro 'dfs';
+ use base qw/텟Ṱ::Ḟ/;
+
+ package 텟Ṱ::Ḵ; use mro 'dfs';
+ use base qw/텟Ṱ::J 텟Ṱ::ᶦ/;
+}
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ᐊ'),
+ [ qw(텟Ṱ::ᐊ) ]
+), '... got the right DFS merge order for 텟Ṱ::ᐊ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ḅ'),
+ [ qw(텟Ṱ::ḅ) ]
+), '... got the right DFS merge order for 텟Ṱ::ḅ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ȼ'),
+ [ qw(텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::ȼ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḏ'),
+ [ qw(텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::Ḏ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ӭ'),
+ [ qw(텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::Ӭ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḟ'),
+ [ qw(텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::Ḟ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ḡ'),
+ [ qw(텟Ṱ::ḡ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::ḡ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḣ'),
+ [ qw(텟Ṱ::Ḣ 텟Ṱ::ḡ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::Ḣ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::ᶦ'),
+ [ qw(텟Ṱ::ᶦ 텟Ṱ::Ḣ 텟Ṱ::ḡ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ 텟Ṱ::Ḟ 텟Ṱ::Ӭ) ]
+), '... got the right DFS merge order for 텟Ṱ::ᶦ');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::J'),
+ [ qw(텟Ṱ::J 텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ) ]
+), '... got the right DFS merge order for 텟Ṱ::J');
+
+ok(eq_array(
+ mro::get_linear_isa('텟Ṱ::Ḵ'),
+ [ qw(텟Ṱ::Ḵ 텟Ṱ::J 텟Ṱ::Ḟ 텟Ṱ::Ӭ 텟Ṱ::Ḏ 텟Ṱ::ᐊ 텟Ṱ::ḅ 텟Ṱ::ȼ 텟Ṱ::ᶦ 텟Ṱ::Ḣ 텟Ṱ::ḡ) ]
+), '... got the right DFS merge order for 텟Ṱ::Ḵ');
diff --git a/t/mro/dbic_c3_utf8.t b/t/mro/dbic_c3_utf8.t
new file mode 100644
index 0000000000..0dbf32e548
--- /dev/null
+++ b/t/mro/dbic_c3_utf8.t
@@ -0,0 +1,121 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 1);
+
+=pod
+
+This example is taken from the inheritance graph of DBIx::Class::Core in DBIx::Class v0.07002:
+(No ASCII art this time, this graph is insane)
+
+The xx:: prefixes are just to be sure these bogus declarations never stomp on real ones
+
+=cut
+
+{
+ package Ẋẋ::ḐʙIX::Cl았::Coレ; use mro 'c3';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::ᓭᚱi알ḭźɜ::Sᑐ랍lえ
+ Ẋẋ::ḐʙIX::Cl았::Ĭⁿᰒ텣올움ᶮ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ::Ạuต
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ
+ Ẋẋ::ḐʙIX::Cl았::ロẈ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy::탑lẹ
+ Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::Ĭⁿᰒ텣올움ᶮ; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았::ロẈ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ロẈ; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았; use mro 'c3';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::촘폰en팃엗
+ xx::Cl았::닽Ӕ::앛쳇sᚖ
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ; use mro 'c3';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::헬pḜrS
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::앛쳇sᚖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::찻찯eᚪtЁnʂ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::Pr오xᐇMeᖪ옫ś
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::밧え
+ Ẋẋ::ḐʙIX::Cl았
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::헬pḜrS; use mro 'c3';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᛗƳ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᶱn
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::бl옹sTȭ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::ᛗᓆ톰ẰᚿẎ
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::Pr오xᐇMeᖪ옫ś; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::밧え; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ᛕķ::Ạuต; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ᛕķ; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았::ロẈ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy::탑lẹ; use mro 'c3';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy; use mro 'c3';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package xx::Cl았::닽Ӕ::앛쳇sᚖ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᛗƳ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᶱn; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::бl옹sTȭ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::ᛗᓆ톰ẰᚿẎ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::촘폰en팃엗; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::ᓭᚱi알ḭźɜ::Sᑐ랍lえ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::앛쳇sᚖ; our @ISA = (); use mro 'c3';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::찻찯eᚪtЁnʂ; our @ISA = (); use mro 'c3';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Ẋẋ::ḐʙIX::Cl았::Coレ'),
+ [qw/
+ Ẋẋ::ḐʙIX::Cl았::Coレ
+ Ẋẋ::ḐʙIX::Cl았::ᓭᚱi알ḭźɜ::Sᑐ랍lえ
+ Ẋẋ::ḐʙIX::Cl았::Ĭⁿᰒ텣올움ᶮ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::헬pḜrS
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᛗƳ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᶱn
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::бl옹sTȭ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::ᛗᓆ톰ẰᚿẎ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::앛쳇sᚖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::찻찯eᚪtЁnʂ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::Pr오xᐇMeᖪ옫ś
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::밧え
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ::Ạuต
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ
+ Ẋẋ::ḐʙIX::Cl았::ロẈ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy::탑lẹ
+ Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy
+ Ẋẋ::ḐʙIX::Cl았
+ Ẋẋ::ḐʙIX::Cl았::촘폰en팃엗
+ xx::Cl았::닽Ӕ::앛쳇sᚖ
+ /]
+), '... got the right C3 merge order for Ẋẋ::ḐʙIX::Cl았::Core');
diff --git a/t/mro/dbic_dfs_utf8.t b/t/mro/dbic_dfs_utf8.t
new file mode 100644
index 0000000000..cd118159c4
--- /dev/null
+++ b/t/mro/dbic_dfs_utf8.t
@@ -0,0 +1,121 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 1);
+
+=pod
+
+This example is taken from the inheritance graph of DBIx::Class::Coレ in DBIx::Class v0.07002:
+(No ASCII art this time, this graph is insane)
+
+The xx:: prefixes are just to be sure these bogus declarations never stomp on real ones
+
+=cut
+
+{
+ package Ẋẋ::ḐʙIX::Cl았::Coレ; use mro 'dfs';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::ᓭᚱi알ḭźɜ::Sᑐ랍lえ
+ Ẋẋ::ḐʙIX::Cl았::Ĭⁿᰒ텣올움ᶮ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ::Ạuต
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ
+ Ẋẋ::ḐʙIX::Cl았::ロẈ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy::탑lẹ
+ Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::Ĭⁿᰒ텣올움ᶮ; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았::ロẈ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ロẈ; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았; use mro 'dfs';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::촘폰en팃엗
+ xx::Cl았::닽Ӕ::앛쳇sᚖ
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ; use mro 'dfs';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::헬pḜrS
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::앛쳇sᚖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::찻찯eᚪtЁnʂ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::Pr오xᐇMeᖪ옫ś
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::밧え
+ Ẋẋ::ḐʙIX::Cl았
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::헬pḜrS; use mro 'dfs';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᛗƳ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᶱn
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::бl옹sTȭ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::ᛗᓆ톰ẰᚿẎ
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::Pr오xᐇMeᖪ옫ś; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::밧え; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ᛕķ::Ạuต; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ᛕķ; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았::ロẈ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy::탑lẹ; use mro 'dfs';
+ our @ISA = qw/
+ Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy
+ /;
+
+ package Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy; use mro 'dfs';
+ our @ISA = qw/ Ẋẋ::ḐʙIX::Cl았 /;
+
+ package xx::Cl았::닽Ӕ::앛쳇sᚖ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᛗƳ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᶱn; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::бl옹sTȭ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::ᛗᓆ톰ẰᚿẎ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::촘폰en팃엗; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::ᓭᚱi알ḭźɜ::Sᑐ랍lえ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::앛쳇sᚖ; our @ISA = (); use mro 'dfs';
+ package Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::찻찯eᚪtЁnʂ; our @ISA = (); use mro 'dfs';
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Ẋẋ::ḐʙIX::Cl았::Coレ'),
+ [qw/
+ Ẋẋ::ḐʙIX::Cl았::Coレ
+ Ẋẋ::ḐʙIX::Cl았::ᓭᚱi알ḭźɜ::Sᑐ랍lえ
+ Ẋẋ::ḐʙIX::Cl았::Ĭⁿᰒ텣올움ᶮ
+ Ẋẋ::ḐʙIX::Cl았::ロẈ
+ Ẋẋ::ḐʙIX::Cl았
+ Ẋẋ::ḐʙIX::Cl았::촘폰en팃엗
+ xx::Cl았::닽Ӕ::앛쳇sᚖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::헬pḜrS
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᛗƳ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::핫ᶱn
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::бl옹sTȭ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::ᛗᓆ톰ẰᚿẎ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::앛쳇sᚖ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::찻찯eᚪtЁnʂ
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::Pr오xᐇMeᖪ옫ś
+ Ẋẋ::ḐʙIX::Cl았::렐aチ온ሺṖ::밧え
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ::Ạuต
+ Ẋẋ::ḐʙIX::Cl았::ᛕķ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy::탑lẹ
+ Ẋẋ::ḐʙIX::Cl았::ᚪc엤ȭઋᶢऋouꩇ
+ Ẋẋ::ḐʙIX::Cl았::ResultSourceProxy
+ /]
+), '... got the right DFS merge order for Ẋẋ::ḐʙIX::Cl았::Coレ');
diff --git a/t/mro/inconsistent_c3_utf8.t b/t/mro/inconsistent_c3_utf8.t
new file mode 100644
index 0000000000..a8ba95810f
--- /dev/null
+++ b/t/mro/inconsistent_c3_utf8.t
@@ -0,0 +1,52 @@
+#!./perl
+
+use strict;
+use warnings;
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 1);
+
+require mro;
+
+=pod
+
+This example is take from: http://www.python.org/2.3/mro.html
+
+"Serious order disagreement" # From Guido
+class O: pass
+class X(O): pass
+class Y(O): pass
+class A(X,Y): pass
+class B(Y,X): pass
+try:
+ class Z(A,B): pass #creates Z(A,B) in Python 2.2
+except TypeError:
+ pass # Z(A,B) cannot be created in Python 2.3
+
+=cut
+
+{
+ package ẋ;
+
+ package Ƴ;
+
+ package ẋƳ;
+ our @ISA = ('ẋ', 'Ƴ');
+
+ package Ƴẋ;
+ our @ISA = ('Ƴ', 'ẋ');
+
+ package Ȥ;
+ our @ISA = ('ẋƳ', 'Ƴẋ');
+}
+
+eval { mro::get_linear_isa('Ȥ', 'c3') };
+like($@, qr/^Inconsistent /, '... got the right error with an inconsistent hierarchy');
diff --git a/t/mro/isa_aliases_utf8.t b/t/mro/isa_aliases_utf8.t
new file mode 100644
index 0000000000..ef715a2eb1
--- /dev/null
+++ b/t/mro/isa_aliases_utf8.t
@@ -0,0 +1,46 @@
+#!./perl
+
+BEGIN { chdir 't'; @INC = '../lib'; require './test.pl' }
+
+use utf8;
+use open qw( :utf8 :std );
+
+plan 12;
+
+@ฟ옥ʮ::ISA = "ᶶ";
+*ຜ옥ㄏ::ISA = *ฟ옥ʮ::ISA;
+@ฟ옥ʮ::ISA = "Bᐊㄗ";
+
+ok 'ฟ옥ʮ'->isa("Bᐊㄗ"),
+ 'isa after another stash has claimed the @ISA via glob assignment';
+ok 'ຜ옥ㄏ'->isa("Bᐊㄗ"),
+ 'isa on the stash that claimed the @ISA via glob assignment';
+ok !ฟ옥ʮ->isa("ᶶ"),
+ '!isa when another stash has claimed the @ISA via glob assignment';
+ok !ຜ옥ㄏ->isa("ᶶ"),
+ '!isa on the stash that claimed the @ISA via glob assignment';
+
+@ฟ옥ʮ::ISA = "ᶶ";
+*ฟ옥ʮ::ISA = ["Bᐊㄗ"];
+
+ok 'ฟ옥ʮ'->isa("Bᐊㄗ"),
+ 'isa after glob-to-ref assignment when *ISA is shared';
+ok 'ຜ옥ㄏ'->isa("Bᐊㄗ"),
+ 'isa after glob-to-ref assignment on another stash when *ISA is shared';
+ok !ฟ옥ʮ->isa("ᶶ"),
+ '!isa after glob-to-ref assignment when *ISA is shared';
+ok !ຜ옥ㄏ->isa("ᶶ"),
+ '!isa after glob-to-ref assignment on another stash when *ISA is shared';
+
+@ᕘ::ISA = "ᶶ";
+*ጶ::ISA = \@ᕘ::ISA;
+@ᕘ::ISA = "Bᐊㄗ";
+
+ok 'ᕘ'->isa("Bᐊㄗ"),
+ 'isa after another stash has claimed the @ISA via ref-to-glob assignment';
+ok 'ጶ'->isa("Bᐊㄗ"),
+ 'isa on the stash that claimed the @ISA via ref-to-glob assignment';
+ok !ᕘ->isa("ᶶ"),
+ '!isa when another stash has claimed the @ISA via ref-to-glob assignment';
+ok !ጶ->isa("ᶶ"),
+ '!isa on the stash that claimed the @ISA via ref-to-glob assignment';
diff --git a/t/mro/isa_c3_utf8.t b/t/mro/isa_c3_utf8.t
new file mode 100644
index 0000000000..0e69e04eba
--- /dev/null
+++ b/t/mro/isa_c3_utf8.t
@@ -0,0 +1,71 @@
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require "./test.pl";
+}
+
+use strict;
+use utf8;
+use open qw( :utf8 :std );
+
+plan 'no_plan';
+
+# package klonk doesn't have a stash.
+
+package 캎oẃ;
+use mro 'c3';
+
+# No parents
+
+package urḲḵk;
+use mro 'c3';
+
+# 1 parent
+@urḲḵk::ISA = 'kഌoんḰ';
+
+package к;
+use mro 'c3';
+
+# 2 parents
+@urḲḵk::ISA = ('kഌoんḰ', '캎oẃ');
+
+package ṭ화ckэ;
+use mro 'c3';
+
+# No parents, has @ISA
+@ṭ화ckэ::ISA = ();
+
+package Źzzzዟᑉ;
+use mro 'c3';
+
+@Źzzzዟᑉ::ISA = ('ṭ화ckэ', '캎oẃ');
+
+package Ẁ함M;
+use mro 'c3';
+
+@Ẁ함M::ISA = ('캎oẃ', 'ṭ화ckэ');
+
+package main;
+
+my %expect =
+ (
+ kഌoんḰ => [qw(kഌoんḰ)],
+ urḲḵk => [qw(urḲḵk kഌoんḰ 캎oẃ)],
+ 캎oẃ => [qw(캎oẃ)],
+ к => [qw(к)],
+ ṭ화ckэ => [qw(ṭ화ckэ)],
+ Źzzzዟᑉ => [qw(Źzzzዟᑉ ṭ화ckэ 캎oẃ)],
+ Ẁ함M => [qw(Ẁ함M 캎oẃ ṭ화ckэ)],
+ );
+
+foreach my $package (qw(kഌoんḰ urḲḵk 캎oẃ к ṭ화ckэ Źzzzዟᑉ Ẁ함M)) {
+ my $ref = bless [], $package;
+ my $isa = $expect{$package};
+ is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
+
+ foreach my $class ($package, @$isa, 'UNIVERSAL') {
+ isa_ok($ref, $class, $package);
+ }
+}
diff --git a/t/mro/isa_dfs_utf8.t b/t/mro/isa_dfs_utf8.t
new file mode 100644
index 0000000000..b6608be4c4
--- /dev/null
+++ b/t/mro/isa_dfs_utf8.t
@@ -0,0 +1,67 @@
+#!perl -w
+
+BEGIN {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ require "./test.pl";
+}
+
+use strict;
+use utf8;
+use open qw( :utf8 :std );
+
+plan 'no_plan';
+
+# package klonk doesn't have a stash.
+
+package 캎oẃ;
+
+# No parents
+
+package urḲḵk;
+
+# 1 parent
+@urḲḵk::ISA = 'kഌoんḰ';
+
+package к;
+
+# 2 parents
+@urḲḵk::ISA = ('kഌoんḰ', '캎oẃ');
+
+package ṭ화ckэ;
+
+# No parents, has @ISA
+@ṭ화ckэ::ISA = ();
+
+package Źzzzዟᑉ;
+
+@Źzzzዟᑉ::ISA = ('ṭ화ckэ', '캎oẃ');
+
+package Ẁ함M;
+
+@Ẁ함M::ISA = ('캎oẃ', 'ṭ화ckэ');
+
+package main;
+
+require mro;
+
+my %expect =
+ (
+ kഌoんḰ => [qw(kഌoんḰ)],
+ urḲḵk => [qw(urḲḵk kഌoんḰ 캎oẃ)],
+ 캎oẃ => [qw(캎oẃ)],
+ к => [qw(к)],
+ ṭ화ckэ => [qw(ṭ화ckэ)],
+ Źzzzዟᑉ => [qw(Źzzzዟᑉ ṭ화ckэ 캎oẃ)],
+ Ẁ함M => [qw(Ẁ함M 캎oẃ ṭ화ckэ)],
+ );
+
+foreach my $package (qw(kഌoんḰ urḲḵk 캎oẃ к ṭ화ckэ Źzzzዟᑉ Ẁ함M)) {
+ my $ref = bless [], $package;
+ my $isa = $expect{$package};
+ is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
+
+ foreach my $class ($package, @$isa, 'UNIVERSAL') {
+ isa_ok($ref, $class, $package);
+ }
+}
diff --git a/t/mro/isarev_utf8.t b/t/mro/isarev_utf8.t
new file mode 100644
index 0000000000..dff3058ee6
--- /dev/null
+++ b/t/mro/isarev_utf8.t
@@ -0,0 +1,150 @@
+#!./perl
+
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ require q(./test.pl);
+}
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+plan(tests => 24);
+
+use mro;
+
+sub i {
+ my @args = @_;
+ @_
+ = (
+ join(" ", sort @{mro::get_isarev $args[0]}),
+ join(" ", sort @args[1..$#args-1]),
+ pop @args
+ );
+ goto &is;
+}
+
+# Basic isarev updating, when @ISA changes
+@팟tРṉ::ISA = "B옫yპt::ぅงலҬ";
+@S추ঋ::ISA = "B옫yპt::ぅงலҬ";
+@B옫yპt::ぅงலҬ::ISA = "B옫yპt";
+i B옫yპt => qw [ B옫yპt::ぅงலҬ 팟tРṉ S추ঋ ],
+ 'subclasses and subsubclasses are added to isarev';
+@팟tРṉ::ISA = ();
+i B옫yპt => qw [ B옫yპt::ぅงலҬ S추ঋ ],
+ 'single deletion from isarev';
+@B옫yპt::ぅงலҬ::ISA = ();
+i B옫yპt => qw [ ], 'recursive deletion from isarev';
+ # except underneath it is not actually recursive
+
+
+# More complicated tests that move packages around
+
+@훗ㄎએỲ::ISA = "독";
+@독::ISA = "ㄘა읻";
+@ວlƑ::ISA = "ㄘა읻";
+@솜ェ::ƀ란ƌ::ᚿamㅔ::ISA = "독::ㄅ";
+@독::ㄅ::ISA = "TレӔṪ";
+@Frȇe::팀ẽ::ISA = "TレӔṪ";
+@My촐ꡙʳ::ISA = "독::ցളŔ::Leaʇhㄦ";
+@독::ցളŔ::Leaʇhㄦ::ISA = "ցളŔ";
+@AŇℴtḫeᕃ::ցളŔ::ISA = "ցളŔ";
+*팈ዕ:: = *독::;
+delete $::{"독::"};
+i ㄘა읻=>qw[ ວlƑ 팈ዕ ],
+ "deleting a stash elem updates isarev entries";
+i TレӔṪ=>qw[ Frȇe::팀ẽ 팈ዕ::ㄅ ],
+ "deleting a nested stash elem updates isarev entries";
+i ցളŔ=>qw[ AŇℴtḫeᕃ::ցളŔ 팈ዕ::ցളŔ::Leaʇhㄦ ],
+ "deleting a doubly nested stash elem updates isarev entries";
+
+@ごଅt::ISA = "ぅงலҬ";
+@ごଅt::DଐɾẎ::ISA = "ごଅt";
+@ごଅt::DଐɾẎ::Ⱦ옥ゲᕟƃᚒḠ::ISA = "ごଅt::DଐɾẎ";
+@웨ɪrƌ::ጢᶯᵷ::ISA = "g";
+*g:: = *ごଅt::;
+i ごଅt => qw[ ごଅt::DଐɾẎ ごଅt::DଐɾẎ::Ⱦ옥ゲᕟƃᚒḠ 웨ɪrƌ::ጢᶯᵷ ],
+ "isarev includes subclasses of aliases";
+delete $::{"g::"};
+i ぅงலҬ => qw[ ごଅt ごଅt::DଐɾẎ ごଅt::DଐɾẎ::Ⱦ옥ゲᕟƃᚒḠ ],
+ "deleting an alias to a package updates isarev entries";
+i"ごଅt" => qw[ ごଅt::DଐɾẎ ごଅt::DଐɾẎ::Ⱦ옥ゲᕟƃᚒḠ ],
+ "deleting an alias to a package updates isarev entries of nested stashes";
+i"ごଅt::DଐɾẎ" => qw[ ごଅt::DଐɾẎ::Ⱦ옥ゲᕟƃᚒḠ ],
+ "deleting an stash alias updates isarev entries of doubly nested stashes";
+i g => qw [ 웨ɪrƌ::ጢᶯᵷ ],
+ "subclasses of the deleted alias become part of its isarev";
+
+@챂린ẽ::ISA = "Hഓf엗::맘말";
+@챂린ẽ::DଐɾẎ::ISA = "챂린ẽ";
+@챂린ẽ::DଐɾẎ::Obェʶ핫l::ISA = "챂린ẽ::DଐɾẎ";
+@ẂhaƮᵋቭȓ::ISA = "챂린ẽ";
+*챂릳:: = *챂린ẽ::;
+*챂린ẽ:: = *ㄔɘvレ::;
+i"Hഓf엗::맘말" => qw[ 챂릳 ],
+ "replacing a stash updates isarev entries";
+i ㄔɘvレ => qw[ 챂릳::DଐɾẎ ẂhaƮᵋቭȓ ],
+ "replacing nested stashes updates isarev entries";
+
+@ᛑiስアsઍ::ェᔦ::ISA = "ᛑiስアsઍ";
+@ᛑiስアsઍ::ェᔦ::Iṇᚠctĭo웃::ISA = "ᛑiስアsઍ::ェᔦ";
+@Kㄦat옻onj운ctᝁヸቲᔈ::ISA = "ᛑiስアsઍ::Opɥt할및::Iṇᚠctĭo웃";
+*ᛑiስアsઍ::Opɥt할및:: = *ᛑiስアsઍ::ェᔦ::;
+{package 솜e_란돔_new_symbol::Iṇᚠctĭo웃} # autovivify
+*ᛑiስアsઍ::Opɥt할및:: = *솜e_란돔_new_symbol::;
+i ᛑiስアsઍ => qw[ ᛑiስアsઍ::ェᔦ ᛑiስアsઍ::ェᔦ::Iṇᚠctĭo웃 ],
+ "replacing an alias of a stash updates isarev entries";
+i"ᛑiስアsઍ::ェᔦ" => qw[ ᛑiስアsઍ::ェᔦ::Iṇᚠctĭo웃 ],
+ "replacing an alias of a stash containing another updates isarev entries";
+i"솜e_란돔_new_symbol::Iṇᚠctĭo웃" => qw[ Kㄦat옻onj운ctᝁヸቲᔈ ],
+ "replacing an alias updates isarev of stashes nested in the replacement";
+
+# Globs ending with :: have autovivified stashes in them by default. We
+# want one without a stash.
+undef *Eṁptᔾ::;
+@눌Ļ::ISA = "Eṁptᔾ";
+@눌Ļ::눌Ļ::ISA = "Eṁptᔾ::Eṁptᔾ";
+{package ዚlcᕻ::Eṁptᔾ} # autovivify it
+*Eṁptᔾ:: = *ዚlcᕻ::;
+i ዚlcᕻ => qw[ 눌Ļ ], "assigning to an empty spot updates isarev";
+i"ዚlcᕻ::Eṁptᔾ" => qw[ 눌Ļ::눌Ļ ],
+ "assigning to an empty spot updates isarev of nested packages";
+
+# Classes inheriting from multiple classes that get moved in a single
+# assignment.
+@ᕘ::ISA = ("ᵇ", "ᵇ::ᵇ");
+{package अ::ᵇ}
+my $अ = \%अ::; # keep a ref
+*अ:: = 'whatever'; # clobber it
+*ᵇ:: = $अ; # assign to two superclasses of ᕘ at the same time
+# There should be no अ::ᵇ isarev entry.
+i"अ::ᵇ" => qw [], 'assigning to two superclasses at the same time';
+ok !ᕘ->isa("अ::ᵇ"),
+ "A class must not inherit from its superclass’s former name";
+
+# undeffing globs
+@α::ISA = 'β';
+$_ = \*α::ISA; # hang on to the glob
+undef *α::ISA;
+i β => qw [], "undeffing an ISA glob deletes isarev entries";
+@aᙇ::ISA = '붘ㆉ';
+$_ = \*aᙇ::ISA;
+undef *aᙇ::;
+i 붘ㆉ => qw [], "undeffing a package glob deletes isarev entries";
+
+# Package aliasing/clobbering when the clobbered package has grandchildren
+# by inheritance.
+@Ƚ::ISA = 'ภɵ';
+@숩Ȼl았A::ISA = "숩Ȼl았Ƃ";
+@숩Ȼl았Ƃ::ISA = "Ƚ";
+*Ƚ:: = *bᚪᶼ::;
+i ภɵ => qw [],
+ 'clobbering a class w/multiple layers of subclasses updates its parent';
+
+@ᖭ랕::ISA = 'S민';
+%ᖭ랕:: = ();
+i S민 => qw [], '%Package:: list assignment';
diff --git a/t/mro/method_caching_utf8.t b/t/mro/method_caching_utf8.t
new file mode 100644
index 0000000000..b0a451dce2
--- /dev/null
+++ b/t/mro/method_caching_utf8.t
@@ -0,0 +1,67 @@
+#!./perl
+
+use utf8;
+use open qw( :utf8 :std );
+use strict;
+use warnings;
+no warnings 'redefine'; # we do a lot of this
+no warnings 'prototype'; # we do a lot of this
+
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+require './test.pl';
+
+{
+ package MC텟ᵀ::Bࡎᶓ;
+ sub ᕘ { return $_[1]+1 };
+
+ package MC텟ᵀ::ድ리ᭉᛞ;
+ our @ISA = qw/MC텟ᵀ::Bࡎᶓ/;
+
+ package Ƒoo; our @ƑOO = qw//;
+}
+
+# These are various ways of re-defining MC텟ᵀ::Bࡎᶓ::ᕘ and checking whether the method is cached when it shouldn't be
+my @testsubs = (
+ sub { is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 1); },
+ sub { eval 'sub MC텟ᵀ::Bࡎᶓ::ᕘ { return $_[1]+2 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 2); },
+ sub { eval 'sub MC텟ᵀ::Bࡎᶓ::ᕘ($) { return $_[1]+3 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 3); },
+ sub { eval 'sub MC텟ᵀ::Bࡎᶓ::ᕘ($) { 4 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 4); },
+ sub { *MC텟ᵀ::Bࡎᶓ::ᕘ = sub { $_[1]+5 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 5); },
+ sub { local *MC텟ᵀ::Bࡎᶓ::ᕘ = sub { $_[1]+6 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 6); },
+ sub { is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 5); },
+ sub { sub FFF { $_[1]+7 }; local *MC텟ᵀ::Bࡎᶓ::ᕘ = *FFF; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 7); },
+ sub { is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 5); },
+ sub { sub DḊƋ { $_[1]+8 }; *MC텟ᵀ::Bࡎᶓ::ᕘ = *DḊƋ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 8); },
+ sub { *ǎᔆɗF::앗dƑ = sub { $_[1]+9 }; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ǎᔆɗF::앗dƑ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 9); },
+ sub { undef *MC텟ᵀ::Bࡎᶓ::ᕘ; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); },
+ sub { eval "sub MC텟ᵀ::Bࡎᶓ::ᕘ($);"; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ǎᔆɗF::앗dƑ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 9); },
+ sub { *Xƴƶ = sub { $_[1]+10 }; ${MC텟ᵀ::Bࡎᶓ::}{ᕘ} = \&Xƴƶ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 10); },
+ sub { ${MC텟ᵀ::Bࡎᶓ::}{ᕘ} = sub { $_[1]+11 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 11); },
+
+ sub { undef *MC텟ᵀ::Bࡎᶓ::ᕘ; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); },
+ sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+12 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 12); },
+ sub { eval 'package ᛎᛎᛎ; sub ᕘ { $_[1]+13 }'; *MC텟ᵀ::Bࡎᶓ::ᕘ = \&ᛎᛎᛎ::ᕘ; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 13); },
+ sub { ${MC텟ᵀ::Bࡎᶓ::}{ᕘ} = sub { $_[1]+14 }; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 14); },
+ # 5.8.8 fails this one
+ sub { undef *{MC텟ᵀ::Bࡎᶓ::}; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); },
+ sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+15 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 15); },
+ sub { undef %{MC텟ᵀ::Bࡎᶓ::}; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); },
+ sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+16 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 16); },
+ sub { %{MC텟ᵀ::Bࡎᶓ::} = (); eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); },
+ sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+17 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 17); },
+ # 5.8.8 fails this one too
+#TODO: This fails due to the tokenizer not being clean, rather than mro.
+ sub { *{MC텟ᵀ::Bࡎᶓ::} = *{Ƒoo::}; eval { MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0) }; like($@, qr/locate object method/); },
+ sub { *MC텟ᵀ::ድ리ᭉᛞ::ᕘ = \&MC텟ᵀ::Bࡎᶓ::ᕘ; eval { MC텟ᵀ::ድ리ᭉᛞ::ᕘ(0,0) }; ok(!$@); undef *MC텟ᵀ::ድ리ᭉᛞ::ᕘ },
+ sub { eval 'package MC텟ᵀ::Bࡎᶓ; sub ᕘ { $_[1]+18 }'; is(MC텟ᵀ::ድ리ᭉᛞ->ᕘ(0), 18); },
+);
+
+plan(tests => scalar(@testsubs));
+
+$_->() for (@testsubs);
diff --git a/t/mro/next_NEXT_utf8.t b/t/mro/next_NEXT_utf8.t
new file mode 100644
index 0000000000..5961a954a2
--- /dev/null
+++ b/t/mro/next_NEXT_utf8.t
@@ -0,0 +1,50 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use NEXT;
+use utf8;
+use open qw( :utf8 :std );
+
+require './test.pl';
+plan(tests => 4);
+
+{
+ package ᕘ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+
+ sub fಓ { 'ᕘ::fಓ' }
+
+ package Fᶽ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ use base 'ᕘ';
+
+ sub fಓ { 'Fᶽ::fಓ => ' . (shift)->next::method }
+
+ package Bᛆ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ use base 'ᕘ';
+
+ sub fಓ { 'Bᛆ::fಓ => ' . (shift)->next::method }
+
+ package Baᕃ;
+ use strict;
+ use warnings;
+
+ use base 'Bᛆ', 'Fᶽ';
+
+ sub fಓ { 'Baᕃ::fಓ => ' . (shift)->NEXT::fಓ }
+}
+
+is(ᕘ->fಓ, 'ᕘ::fಓ', '... got the right value from ᕘ->fಓ');
+is(Fᶽ->fಓ, 'Fᶽ::fಓ => ᕘ::fಓ', '... got the right value from Fᶽ->fಓ');
+is(Bᛆ->fಓ, 'Bᛆ::fಓ => ᕘ::fಓ', '... got the right value from Bᛆ->fಓ');
+
+is(Baᕃ->fಓ, 'Baᕃ::fಓ => Bᛆ::fಓ => Fᶽ::fಓ => ᕘ::fಓ', '... got the right value using NEXT in a subclass of a C3 class');
+
diff --git a/t/mro/next_edgecases_utf8.t b/t/mro/next_edgecases_utf8.t
new file mode 100644
index 0000000000..bd461c777f
--- /dev/null
+++ b/t/mro/next_edgecases_utf8.t
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN { chdir 't'; require q(./test.pl); @INC = qw "../lib lib" }
+
+use utf8;
+use open qw( :utf8 :std );
+
+plan(tests => 12);
+
+{
+
+ {
+ package ᕘ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ sub new { bless {}, $_[0] }
+ sub ƚ { 'ᕘ::ƚ' }
+ }
+
+ # call the submethod in the direct instance
+
+ my $foo = ᕘ->new();
+ isa_ok($foo, 'ᕘ');
+
+ can_ok($foo, 'ƚ');
+ is($foo->ƚ(), 'ᕘ::ƚ', '... got the right return value');
+
+ # fail calling it from a subclass
+
+ {
+ package Baɾ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ our @ISA = ('ᕘ');
+ }
+
+ my $bar = Baɾ->new();
+ isa_ok($bar, 'Baɾ');
+ isa_ok($bar, 'ᕘ');
+
+ # test it working with with Sub::Name
+ SKIP: {
+ eval 'use Sub::Name';
+ skip("Sub::Name is required for this test", 3) if $@;
+
+ my $m = sub { (shift)->next::method() };
+ Sub::Name::subname('Baɾ::ƚ', $m);
+ {
+ no strict 'refs';
+ *{'Baɾ::ƚ'} = $m;
+ }
+
+ can_ok($bar, 'ƚ');
+ my $value = eval { $bar->ƚ() };
+ ok(!$@, '... calling ƚ() succeeded') || diag $@;
+ is($value, 'ᕘ::ƚ', '... got the right return value too');
+ }
+
+ # test it failing without Sub::Name
+ {
+ package બʑ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ our @ISA = ('ᕘ');
+ }
+
+ my $baz = બʑ->new();
+ isa_ok($baz, 'બʑ');
+ isa_ok($baz, 'ᕘ');
+
+ {
+ my $m = sub { (shift)->next::method() };
+ {
+ no strict 'refs';
+ *{'બʑ::ƚ'} = $m;
+ }
+
+ eval { $baz->ƚ() };
+ ok($@, '... calling ƚ() with next::method failed') || diag $@;
+ }
+
+ # Test with non-existing class (used to segfault)
+ {
+ package Qűx;
+ use mro;
+ sub fਓ { No::Such::Class->next::can }
+ }
+
+ eval { Qűx->fਓ() };
+ is($@, '', "->next::can on non-existing package name");
+
+}
diff --git a/t/mro/next_goto_utf8.t b/t/mro/next_goto_utf8.t
new file mode 100644
index 0000000000..3fc66f2a81
--- /dev/null
+++ b/t/mro/next_goto_utf8.t
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+require q(./test.pl); plan(tests => 4);
+
+use mro;
+
+{
+ package PṞoxᚤ;
+ our @ISA = qw//;
+ sub next_prxᔬ { goto &next::method }
+ sub maybe_prxᔬ { goto &maybe::next::method }
+ sub can_prxᔬ { goto &next::can }
+
+ package Ⱦ밧ᶟ;
+ our @ISA = qw//;
+ sub ᕗ { 42 }
+ sub Ƚ { 24 }
+ # বẔ doesn't exist intentionally
+ sub ʠঊₓ { 242 }
+
+ package ᵗ톺;
+ our @ISA = qw/Ⱦ밧ᶟ/;
+ sub ᕗ { shift->PṞoxᚤ::next_prxᔬ() }
+ sub Ƚ { shift->PṞoxᚤ::maybe_prxᔬ() }
+ sub বẔ { shift->PṞoxᚤ::maybe_prxᔬ() }
+ sub ʠঊₓ { shift->PṞoxᚤ::can_prxᔬ()->() }
+}
+
+is(ᵗ톺->ᕗ, 42, 'proxy next::method via goto');
+is(ᵗ톺->Ƚ, 24, 'proxy maybe::next::method via goto');
+ok(!ᵗ톺->বẔ, 'proxy maybe::next::method via goto with no method');
+is(ᵗ톺->ʠঊₓ, 242, 'proxy next::can via goto');
diff --git a/t/mro/next_inanon_utf8.t b/t/mro/next_inanon_utf8.t
new file mode 100644
index 0000000000..d1dd6e4ac3
--- /dev/null
+++ b/t/mro/next_inanon_utf8.t
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+require q(./test.pl); plan(tests => 2);
+
+=pod
+
+This tests the successful handling of a next::method call from within an
+anonymous subroutine.
+
+=cut
+
+{
+ package ㅏ;
+ use mro 'c3';
+
+ sub ᕘ {
+ return 'ㅏ::ᕘ';
+ }
+
+ sub Ḃᛆ {
+ return 'ㅏ::Ḃᛆ';
+ }
+}
+
+{
+ package Ḃ;
+ use base 'ㅏ';
+ use mro 'c3';
+
+ sub ᕘ {
+ my $code = sub {
+ return 'Ḃ::ᕘ => ' . (shift)->next::method();
+ };
+ return (shift)->$code;
+ }
+
+ sub Ḃᛆ {
+ my $code1 = sub {
+ my $code2 = sub {
+ return 'Ḃ::Ḃᛆ => ' . (shift)->next::method();
+ };
+ return (shift)->$code2;
+ };
+ return (shift)->$code1;
+ }
+}
+
+is(Ḃ->ᕘ, "Ḃ::ᕘ => ㅏ::ᕘ",
+ 'method resolved inside anonymous sub');
+
+is(Ḃ->Ḃᛆ, "Ḃ::Ḃᛆ => ㅏ::Ḃᛆ",
+ 'method resolved inside nested anonymous subs');
+
+
diff --git a/t/mro/next_ineval_utf8.t b/t/mro/next_ineval_utf8.t
new file mode 100644
index 0000000000..cd44f6c04a
--- /dev/null
+++ b/t/mro/next_ineval_utf8.t
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 1);
+
+=pod
+
+This tests the use of an eval{} block to wrap a next::method call.
+
+=cut
+
+{
+ package అ;
+ use mro 'c3';
+
+ sub ຟǫ {
+ die 'అ::ຟǫ died';
+ return 'అ::ຟǫ succeeded';
+ }
+}
+
+{
+ package b;
+ use base 'అ';
+ use mro 'c3';
+
+ sub ຟǫ {
+ eval {
+ return 'b::ຟǫ => ' . (shift)->next::method();
+ };
+
+ if ($@) {
+ return $@;
+ }
+ }
+}
+
+like(b->ຟǫ,
+ qr/^అ::ຟǫ died/u,
+ 'method resolved inside eval{}');
+
+
diff --git a/t/mro/next_method_utf8.t b/t/mro/next_method_utf8.t
new file mode 100644
index 0000000000..aa0b6307ef
--- /dev/null
+++ b/t/mro/next_method_utf8.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 5);
+
+=pod
+
+This tests the classic diamond inheritance pattern.
+
+ <A>
+ / \
+<B> <C>
+ \ /
+ <D>
+
+=cut
+
+{
+ package Diӑmond_A;
+ use mro 'c3';
+ sub 헬ฬ { 'Diӑmond_A::헬ฬ' }
+ sub fಓ { 'Diӑmond_A::fಓ' }
+}
+{
+ package Diӑmond_B;
+ use base 'Diӑmond_A';
+ use mro 'c3';
+ sub fಓ { 'Diӑmond_B::fಓ => ' . (shift)->next::method() }
+}
+{
+ package Diӑmond_C;
+ use mro 'c3';
+ use base 'Diӑmond_A';
+
+ sub 헬ฬ { 'Diӑmond_C::헬ฬ => ' . (shift)->next::method() }
+ sub fಓ { 'Diӑmond_C::fಓ => ' . (shift)->next::method() }
+}
+{
+ package Diӑmond_D;
+ use base ('Diӑmond_B', 'Diӑmond_C');
+ use mro 'c3';
+
+ sub fಓ { 'Diӑmond_D::fಓ => ' . (shift)->next::method() }
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Diӑmond_D'),
+ [ qw(Diӑmond_D Diӑmond_B Diӑmond_C Diӑmond_A) ]
+), '... got the right MRO for Diӑmond_D');
+
+is(Diӑmond_D->헬ฬ, 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ', '... method resolved itself as expected');
+
+is(Diӑmond_D->can('헬ฬ')->('Diӑmond_D'),
+ 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ',
+ '... can(method) resolved itself as expected');
+
+is(UNIVERSAL::can("Diӑmond_D", '헬ฬ')->('Diӑmond_D'),
+ 'Diӑmond_C::헬ฬ => Diӑmond_A::헬ฬ',
+ '... can(method) resolved itself as expected');
+
+is(Diӑmond_D->fಓ,
+ 'Diӑmond_D::fಓ => Diӑmond_B::fಓ => Diӑmond_C::fಓ => Diӑmond_A::fಓ',
+ '... method fಓ resolved itself as expected');
diff --git a/t/mro/next_skip_utf8.t b/t/mro/next_skip_utf8.t
new file mode 100644
index 0000000000..9dd465990c
--- /dev/null
+++ b/t/mro/next_skip_utf8.t
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+require q(./test.pl); plan(tests => 10);
+
+use utf8;
+use open qw( :utf8 :std );
+
+=pod
+
+This tests the classic diamond inheritance pattern.
+
+ <A>
+ / \
+<B> <C>
+ \ /
+ <D>
+
+=cut
+
+{
+ package Diᚪၚd_A;
+ use mro 'c3';
+ sub ᴮaȐ { 'Diᚪၚd_A::ᴮaȐ' }
+ sub 바ź { 'Diᚪၚd_A::바ź' }
+}
+{
+ package Diᚪၚd_B;
+ use base 'Diᚪၚd_A';
+ use mro 'c3';
+ sub 바ź { 'Diᚪၚd_B::바ź => ' . (shift)->next::method() }
+}
+{
+ package Diᚪၚd_C;
+ use mro 'c3';
+ use base 'Diᚪၚd_A';
+ sub ᕘ { 'Diᚪၚd_C::ᕘ' }
+ sub buƵ { 'Diᚪၚd_C::buƵ' }
+
+ sub woz { 'Diᚪၚd_C::woz' }
+ sub maᐇbʚ { 'Diᚪၚd_C::maᐇbʚ' }
+}
+{
+ package Diᚪၚd_D;
+ use base ('Diᚪၚd_B', 'Diᚪၚd_C');
+ use mro 'c3';
+ sub ᕘ { 'Diᚪၚd_D::ᕘ => ' . (shift)->next::method() }
+ sub ᴮaȐ { 'Diᚪၚd_D::ᴮaȐ => ' . (shift)->next::method() }
+ sub buƵ { 'Diᚪၚd_D::buƵ => ' . (shift)->바ź() }
+ sub fuz { 'Diᚪၚd_D::fuz => ' . (shift)->next::method() }
+
+ sub woz { 'Diᚪၚd_D::woz can => ' . ((shift)->next::can() ? 1 : 0) }
+ sub noz { 'Diᚪၚd_D::noz can => ' . ((shift)->next::can() ? 1 : 0) }
+
+ sub maᐇbʚ { 'Diᚪၚd_D::maᐇbʚ => ' . ((shift)->maybe::next::method() || 0) }
+ sub ᒧyベ { 'Diᚪၚd_D::ᒧyベ => ' . ((shift)->maybe::next::method() || 0) }
+
+}
+
+ok(eq_array(
+ mro::get_linear_isa('Diᚪၚd_D'),
+ [ qw(Diᚪၚd_D Diᚪၚd_B Diᚪၚd_C Diᚪၚd_A) ]
+), '... got the right MRO for Diᚪၚd_D');
+
+is(Diᚪၚd_D->ᕘ, 'Diᚪၚd_D::ᕘ => Diᚪၚd_C::ᕘ', '... skipped B and went to C correctly');
+is(Diᚪၚd_D->ᴮaȐ, 'Diᚪၚd_D::ᴮaȐ => Diᚪၚd_A::ᴮaȐ', '... skipped B & C and went to A correctly');
+is(Diᚪၚd_D->바ź, 'Diᚪၚd_B::바ź => Diᚪၚd_A::바ź', '... called B method, skipped C and went to A correctly');
+is(Diᚪၚd_D->buƵ, 'Diᚪၚd_D::buƵ => Diᚪၚd_B::바ź => Diᚪၚd_A::바ź', '... called D method dispatched to , different method correctly');
+TODO: {
+ local our $TODO = "Warnings aren't clean yet";
+ eval { Diᚪၚd_D->fuz };
+ like($@, qr/^No next::method 'fuz' found for Diᚪၚd_D/u, '... cannot re-dispatch to a method which is not there');
+}
+is(Diᚪၚd_D->woz, 'Diᚪၚd_D::woz can => 1', '... can re-dispatch figured out correctly');
+is(Diᚪၚd_D->noz, 'Diᚪၚd_D::noz can => 0', '... cannot re-dispatch figured out correctly');
+
+is(Diᚪၚd_D->maᐇbʚ, 'Diᚪၚd_D::maᐇbʚ => Diᚪၚd_C::maᐇbʚ', '... redispatched D to C when it exists');
+is(Diᚪၚd_D->ᒧyベ, 'Diᚪၚd_D::ᒧyベ => 0', '... quietly failed redispatch from D');
diff --git a/t/mro/overload_c3_utf8.t b/t/mro/overload_c3_utf8.t
new file mode 100644
index 0000000000..5a483ef5c0
--- /dev/null
+++ b/t/mro/overload_c3_utf8.t
@@ -0,0 +1,57 @@
+#!./perl
+
+use strict;
+use warnings;
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+
+use utf8;
+use open qw( :utf8 :std );
+
+require q(./test.pl); plan(tests => 7);
+
+{
+ package 밧e텟ʇ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+
+ package Ov에rꪩࡃᛝTeŝṱ;
+ use strict;
+ use warnings;
+ use mro 'c3';
+ use base '밧e텟ʇ';
+ use overload '""' => sub { ref(shift) . " stringified" },
+ fallback => 1;
+
+ sub ネᚹ { bless {} => shift }
+
+ package 읺ҎꀀḮṆᵷꜰ롬ᵕveŔŁoad엗텟ᵵ;
+ use strict;
+ use warnings;
+ use base 'Ov에rꪩࡃᛝTeŝṱ';
+ use mro 'c3';
+}
+
+my $x = 읺ҎꀀḮṆᵷꜰ롬ᵕveŔŁoad엗텟ᵵ->ネᚹ();
+isa_ok($x, '읺ҎꀀḮṆᵷꜰ롬ᵕveŔŁoad엗텟ᵵ');
+
+my $y = Ov에rꪩࡃᛝTeŝṱ->ネᚹ();
+isa_ok($y, 'Ov에rꪩࡃᛝTeŝṱ');
+
+is("$x", '읺ҎꀀḮṆᵷꜰ롬ᵕveŔŁoad엗텟ᵵ stringified', '... got the right value when stringifing');
+is("$y", 'Ov에rꪩࡃᛝTeŝṱ stringified', '... got the right value when stringifing');
+
+ok(($y eq 'Ov에rꪩࡃᛝTeŝṱ stringified'), '... eq was handled correctly');
+
+my $result;
+eval {
+ $result = $x eq '읺ҎꀀḮṆᵷꜰ롬ᵕveŔŁoad엗텟ᵵ stringified'
+};
+ok(!$@, '... this should not throw an exception');
+ok($result, '... and we should get the true value');
+
diff --git a/t/mro/package_aliases_utf8.t b/t/mro/package_aliases_utf8.t
new file mode 100644
index 0000000000..ae214e5ce5
--- /dev/null
+++ b/t/mro/package_aliases_utf8.t
@@ -0,0 +1,468 @@
+#!./perl
+
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ require q(./test.pl);
+}
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+plan(tests => 52);
+
+{
+ package Neẁ;
+ use strict;
+ use warnings;
+
+ package ऑlㄉ;
+ use strict;
+ use warnings;
+
+ {
+ no strict 'refs';
+ *{'ऑlㄉ::'} = *{'Neẁ::'};
+ }
+}
+
+ok (ऑlㄉ->isa(Neẁ::), 'ऑlㄉ inherits from Neẁ');
+ok (Neẁ->isa(ऑlㄉ::), 'Neẁ inherits from ऑlㄉ');
+
+isa_ok (bless ({}, ऑlㄉ::), Neẁ::, 'ऑlㄉ object');
+isa_ok (bless ({}, Neẁ::), ऑlㄉ::, 'Neẁ object');
+
+
+# Test that replacing a package by assigning to an existing glob
+# invalidates the isa caches
+for(
+ {
+ name => 'assigning a glob to a glob',
+ code => '$life_raft = $::{"lㅔf::"}; *lㅔf:: = $::{"릭Ⱶᵀ::"}',
+ },
+ {
+ name => 'assigning a string to a glob',
+ code => '$life_raft = $::{"lㅔf::"}; *lㅔf:: = "릭Ⱶᵀ::"',
+ },
+ {
+ name => 'assigning a stashref to a glob',
+ code => '$life_raft = \%lㅔf::; *lㅔf:: = \%릭Ⱶᵀ::',
+ },
+) {
+my $prog = q~
+ BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ }
+ use utf8;
+ use open qw( :utf8 :std );
+
+ @숩cਲꩋ::ISA = "lㅔf";
+ @lㅔf::ISA = "톺ĺФț";
+
+ sub 톺ĺФț::Sᑊeಅḱ { "Woof!" }
+ sub ᴖ릭ᚽʇ::Sᑊeಅḱ { "Bow-wow!" }
+
+ my $thing = bless [], "숩cਲꩋ";
+
+ # mro_package_moved needs to know to skip non-globs
+ $릭Ⱶᵀ::{"ᚷꝆエcƙ::"} = 3;
+
+ @릭Ⱶᵀ::ISA = 'ᴖ릭ᚽʇ';
+ my $life_raft;
+ __code__;
+
+ print $thing->Sᑊeಅḱ, "\n";
+
+ undef $life_raft;
+ print $thing->Sᑊeಅḱ, "\n";
+ ~ =~ s\__code__\$$_{code}\r; #\
+utf8::encode($prog);
+ fresh_perl_is
+ $prog,
+ "Bow-wow!\nBow-wow!\n",
+ {},
+ "replacing packages by $$_{name} updates isa caches";
+}
+
+# Similar test, but with nested packages
+#
+# 톺ĺФț (Woof) ᴖ릭ᚽʇ (Bow-wow)
+# | |
+# lㅔf::Side <- 릭Ⱶᵀ::Side
+# |
+# 숩cਲꩋ
+#
+# This test assigns 릭Ⱶᵀ:: to lㅔf::, indirectly making lㅔf::Side an
+# alias to 릭Ⱶᵀ::Side (following the arrow in the diagram).
+for(
+ {
+ name => 'assigning a glob to a glob',
+ code => '$life_raft = $::{"lㅔf::"}; *lㅔf:: = $::{"릭Ⱶᵀ::"}',
+ },
+ {
+ name => 'assigning a string to a glob',
+ code => '$life_raft = $::{"lㅔf::"}; *lㅔf:: = "릭Ⱶᵀ::"',
+ },
+ {
+ name => 'assigning a stashref to a glob',
+ code => '$life_raft = \%lㅔf::; *lㅔf:: = \%릭Ⱶᵀ::',
+ },
+) {
+ my $prog = q~
+ BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ }
+ use utf8;
+ use open qw( :utf8 :std );
+ @숩cਲꩋ::ISA = "lㅔf::Side";
+ @lㅔf::Side::ISA = "톺ĺФț";
+
+ sub 톺ĺФț::Sᑊeಅḱ { "Woof!" }
+ sub ᴖ릭ᚽʇ::Sᑊeಅḱ { "Bow-wow!" }
+
+ my $thing = bless [], "숩cਲꩋ";
+
+ @릭Ⱶᵀ::Side::ISA = 'ᴖ릭ᚽʇ';
+ my $life_raft;
+ __code__;
+
+ print $thing->Sᑊeಅḱ, "\n";
+
+ undef $life_raft;
+ print $thing->Sᑊeಅḱ, "\n";
+ ~ =~ s\__code__\$$_{code}\r;
+ utf8::encode($prog);
+
+ fresh_perl_is
+ $prog,
+ "Bow-wow!\nBow-wow!\n",
+ {},
+ "replacing nested packages by $$_{name} updates isa caches";
+}
+
+# Another nested package test, in which the isa cache needs to be reset on
+# the subclass of a package that does not exist.
+#
+# Parenthesized packages do not exist.
+#
+# ɵűʇㄦ::인ንʵ ( cฬnए::인ንʵ )
+# | |
+# Lфť R익hȚ
+#
+# ɵűʇㄦ -> cฬnए
+#
+# This test assigns ɵűʇㄦ:: to cฬnए::, making cฬnए::인ንʵ an alias to
+# ɵűʇㄦ::인ንʵ.
+#
+# Then we also run the test again, but without ɵűʇㄦ::인ንʵ
+for(
+ {
+ name => 'assigning a glob to a glob',
+ code => '*cฬnए:: = *ɵűʇㄦ::',
+ },
+ {
+ name => 'assigning a string to a glob',
+ code => '*cฬnए:: = "ɵűʇㄦ::"',
+ },
+ {
+ name => 'assigning a stashref to a glob',
+ code => '*cฬnए:: = \%ɵűʇㄦ::',
+ },
+) {
+ for my $tail ('인ንʵ', '인ንʵ::', '인ንʵ:::', '인ንʵ::::') {
+ my $prog = q~
+ BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ }
+ use utf8;
+ use open qw( :utf8 :std );
+ use Encode ();
+
+ if (grep /\P{ASCII}/, @ARGV) {
+ @ARGV = map { Encode::decode("UTF-8", $_) } @ARGV;
+ }
+
+ my $tail = shift;
+ @Lфť::ISA = "ɵűʇㄦ::$tail";
+ @R익hȚ::ISA = "cฬnए::$tail";
+ bless [], "ɵűʇㄦ::$tail"; # autovivify the stash
+
+ __code__;
+
+ print "ok 1", "\n" if Lфť->isa("cฬnए::$tail");
+ print "ok 2", "\n" if R익hȚ->isa("ɵűʇㄦ::$tail");
+ print "ok 3", "\n" if R익hȚ->isa("cฬnए::$tail");
+ print "ok 4", "\n" if Lфť->isa("ɵűʇㄦ::$tail");
+ ~ =~ s\__code__\$$_{code}\r;
+ utf8::encode($prog);
+ fresh_perl_is
+ $prog,
+ "ok 1\nok 2\nok 3\nok 4\n",
+ { args => [$tail] },
+ "replacing nonexistent nested packages by $$_{name} updates isa caches"
+ ." ($tail)";
+
+ # Same test but with the subpackage autovivified after the assignment
+ $prog = q~
+ BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ }
+ use utf8;
+ use open qw( :utf8 :std );
+ use Encode ();
+
+ if (grep /\P{ASCII}/, @ARGV) {
+ @ARGV = map { Encode::decode("UTF-8", $_) } @ARGV;
+ }
+
+ my $tail = shift;
+ @Lфť::ISA = "ɵűʇㄦ::$tail";
+ @R익hȚ::ISA = "cฬnए::$tail";
+
+ __code__;
+
+ bless [], "ɵűʇㄦ::$tail";
+
+ print "ok 1", "\n" if Lфť->isa("cฬnए::$tail");
+ print "ok 2", "\n" if R익hȚ->isa("ɵűʇㄦ::$tail");
+ print "ok 3", "\n" if R익hȚ->isa("cฬnए::$tail");
+ print "ok 4", "\n" if Lфť->isa("ɵűʇㄦ::$tail");
+ ~ =~ s\__code__\$$_{code}\r;
+ utf8::encode($prog);
+ fresh_perl_is
+ $prog,
+ "ok 1\nok 2\nok 3\nok 4\n",
+ { args => [$tail] },
+ "Giving nonexistent packages multiple effective names by $$_{name}"
+ . " ($tail)";
+ }
+}
+
+no warnings; # temporary; there seems to be a scoping bug, as this does not
+ # work when placed in the blocks below
+
+# Test that deleting stash elements containing
+# subpackages also invalidates the isa cache.
+# Maybe this does not belong in package_aliases.t, but it is closely
+# related to the tests immediately preceding.
+{
+ @ቹऋ::ISA = ("Cuȓ", "ฮンᛞ");
+ @Cuȓ::ISA = "Hyḹ앛Ҭテ";
+
+ sub Hyḹ앛Ҭテ::Sᑊeಅḱ { "Arff!" }
+ sub ฮンᛞ::Sᑊeಅḱ { "Woof!" }
+
+ my $pet = bless [], "ቹऋ";
+
+ my $life_raft = delete $::{'Cuȓ::'};
+
+ is $pet->Sᑊeಅḱ, 'Woof!',
+ 'deleting a stash from its parent stash invalidates the isa caches';
+
+ undef $life_raft;
+ is $pet->Sᑊeಅḱ, 'Woof!',
+ 'the deleted stash is gone completely when freed';
+}
+# Same thing, but with nested packages
+{
+ @펱ᑦ::ISA = ("Cuȓȓ::Cuȓȓ::Cuȓȓ", "ɥwn");
+ @Cuȓȓ::Cuȓȓ::Cuȓȓ::ISA = "lȺt랕ᚖ";
+
+ sub lȺt랕ᚖ::Sᑊeಅḱ { "Arff!" }
+ sub ɥwn::Sᑊeಅḱ { "Woof!" }
+
+ my $pet = bless [], "펱ᑦ";
+
+ my $life_raft = delete $::{'Cuȓȓ::'};
+
+ is $pet->Sᑊeಅḱ, 'Woof!',
+ 'deleting a stash from its parent stash resets caches of substashes';
+
+ undef $life_raft;
+ is $pet->Sᑊeಅḱ, 'Woof!',
+ 'the deleted substash is gone completely when freed';
+}
+
+# [perl #77358]
+my $prog = q~#!perl -w
+ BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+ }
+ use utf8;
+ use open qw( :utf8 :std );
+ @펱ᑦ::ISA = "T잌ዕ";
+ @T잌ዕ::ISA = "Bᛆヶṝ";
+
+ sub Bᛆヶṝ::Sᑊeಅḱ { print "Woof!\n" }
+ sub lȺt랕ᚖ::Sᑊeಅḱ { print "Bow-wow!\n" }
+
+ my $pet = bless [], "펱ᑦ";
+
+ $pet->Sᑊeಅḱ;
+
+ sub ດƓ::Sᑊeಅḱ { print "Hello.\n" } # strange ດƓ!
+ @ດƓ::ISA = 'lȺt랕ᚖ';
+ *T잌ዕ:: = delete $::{'ດƓ::'};
+
+ $pet->Sᑊeಅḱ;
+ ~;
+utf8::encode($prog);
+fresh_perl_is
+ $prog,
+ "Woof!\nHello.\n",
+ { stderr => 1 },
+ "Assigning a nameless package over one w/subclasses updates isa caches";
+
+# mro_package_moved needs to make a distinction between replaced and
+# assigned stashes when keeping track of what it has seen so far.
+no warnings; {
+ no strict 'refs';
+
+ sub ʉ::bᓗnǩ::bᓗnǩ::ພo { "bbb" }
+ sub ᵛeↄl움::ພo { "lasrevinu" }
+ @ݏ엗Ƚeᵬૐᵖ::ISA = qw 'ພo::bᓗnǩ::bᓗnǩ ᵛeↄl움';
+ *ພo::ବㄗ:: = *ʉ::bᓗnǩ::; # now ʉ::bᓗnǩ:: is on both sides
+ *ພo:: = *ʉ::; # here ʉ::bᓗnǩ:: is both deleted and added
+ *ʉ:: = *ቦᵕ::; # now it is only known as ພo::bᓗnǩ::
+
+ # At this point, before the bug was fixed, %ພo::bᓗnǩ::bᓗnǩ:: ended
+ # up with no effective name, allowing it to be deleted without updating
+ # its subclasses’ caches.
+
+ my $accum = '';
+
+ $accum .= 'ݏ엗Ƚeᵬૐᵖ'->ພo; # bbb
+ delete ${"ພo::bᓗnǩ::"}{"bᓗnǩ::"};
+ $accum .= 'ݏ엗Ƚeᵬૐᵖ'->ພo; # bbb (Oops!)
+ @ݏ엗Ƚeᵬૐᵖ::ISA = @ݏ엗Ƚeᵬૐᵖ::ISA;
+ $accum .= 'ݏ엗Ƚeᵬૐᵖ'->ພo; # lasrevinu
+
+ is $accum, 'bbblasrevinulasrevinu',
+ 'nested classes deleted & added simultaneously';
+}
+use warnings;
+
+# mro_package_moved needs to check for self-referential packages.
+# This broke Text::Template [perl #78362].
+watchdog 3;
+*ᕘ:: = \%::;
+*Aᶜme::Mῌ::Aᶜme:: = \*Aᶜme::; # indirect self-reference
+pass("mro_package_moved and self-referential packages");
+
+# Deleting a glob whose name does not indicate its location in the symbol
+# table but which nonetheless *is* in the symbol table.
+{
+ no strict refs=>;
+ no warnings;
+ @ოƐ::mഒrェ::ISA = "foᚒ";
+ sub foᚒ::ວmᑊ { "aoeaa" }
+ *ťວ:: = *ოƐ::;
+ delete $::{"ოƐ::"};
+ @C힐dᒡl았::ISA = 'ťວ::mഒrェ';
+ my $accum = 'C힐dᒡl았'->ວmᑊ . '-';
+ my $life_raft = delete ${"ťວ::"}{"mഒrェ::"};
+ $accum .= eval { 'C힐dᒡl았'->ວmᑊ } // '<undef>';
+ is $accum, 'aoeaa-<undef>',
+ 'Deleting globs whose loc in the symtab differs from gv_fullname'
+}
+
+# Pathological test for undeffing a stash that has an alias.
+*ᵍh엞:: = *ኔƞ::;
+@숩cਲꩋ::ISA = 'ᵍh엞';
+undef %ᵍh엞::;
+sub F렐ᛔ::ວmᑊ { "clumpren" }
+eval '
+ $ኔƞ::whatever++;
+ @ኔƞ::ISA = "F렐ᛔ";
+';
+is eval { '숩cਲꩋ'->ວmᑊ }, 'clumpren',
+ 'Changes to @ISA after undef via original name';
+undef %ᵍh엞::;
+eval '
+ $ᵍh엞::whatever++;
+ @ᵍh엞::ISA = "F렐ᛔ";
+';
+is eval { '숩cਲꩋ'->ວmᑊ }, 'clumpren',
+ 'Changes to @ISA after undef via alias';
+
+
+# Packages whose containing stashes have aliases must lose all names cor-
+# responding to that container when detached.
+{
+ {package śmᛅḙ::በɀ} # autovivify
+ *pḢ린ᚷ:: = *śmᛅḙ::; # śmᛅḙ::በɀ now also named pḢ린ᚷ::በɀ
+ *본:: = delete $śmᛅḙ::{"በɀ::"};
+ # In 5.13.7, it has now lost its śmᛅḙ::በɀ name (reverting to pḢ린ᚷ::በɀ
+ # as the effective name), and gained 본 as an alias.
+ # In 5.13.8, both śmᛅḙ::በɀ *and* pḢ린ᚷ::በɀ names are deleted.
+
+ # Make some methods
+ no strict 'refs';
+ *{"pḢ린ᚷ::በɀ::fฤmᛈ"} = sub { "hello" };
+ sub Fルmፕṟ::fฤmᛈ { "good bye" };
+
+ @ᵇるᣘ킨::ISA = qw "본 Fルmፕṟ"; # now wrongly inherits from pḢ린ᚷ::በɀ
+
+ is fฤmᛈ ᵇるᣘ킨, "good bye",
+ 'detached stashes lose all names corresponding to the containing stash';
+}
+
+# Crazy edge cases involving packages ending with a single :
+@촐oン::ISA = 'ᚖგ:'; # pun intended!
+bless [], "ᚖგ:"; # autovivify the stash
+ok "촐oン"->isa("ᚖგ:"), 'class isa "class:"';
+{ no strict 'refs'; *{"ᚖგ:::"} = *ᚖგ:: }
+ok "촐oン"->isa("ᚖგ"),
+ 'isa(ᕘ) when inheriting from "class:" which is an alias for ᕘ';
+{
+ no warnings;
+ # The next line of code is *not* normative. If the structure changes,
+ # this line needs to change, too.
+ my $ᕘ = delete $ᚖგ::{":"};
+ ok !촐oン->isa("ᚖგ"),
+ 'class that isa "class:" no longer isa ᕘ if "class:" has been deleted';
+}
+@촐oン::ISA = ':';
+bless [], ":";
+ok "촐oン"->isa(":"), 'class isa ":"';
+{ no strict 'refs'; *{":::"} = *ፑňṪu앝ȋ온:: }
+ok "촐oン"->isa("ፑňṪu앝ȋ온"),
+ 'isa(ᕘ) when inheriting from ":" which is an alias for ᕘ';
+@촐oン::ISA = 'ᚖგ:';
+bless [], "ᚖგ:";
+{
+ no strict 'refs';
+ my $life_raft = \%{"ᚖგ:::"};
+ *{"ᚖგ:::"} = \%ᚖგ::;
+ ok "촐oン"->isa("ᚖგ"),
+ 'isa(ᕘ) when inheriting from "class:" after hash-to-glob assignment';
+}
+@촐oン::ISA = 'ŏ:';
+bless [], "ŏ:";
+{
+ no strict 'refs';
+ my $life_raft = \%{"ŏ:::"};
+ *{"ŏ:::"} = "ᚖგ::";
+ ok "촐oン"->isa("ᚖგ"),
+ 'isa(ᕘ) when inheriting from "class:" after string-to-glob assignment';
+}
+=cut
diff --git a/t/mro/pkg_gen_utf8.t b/t/mro/pkg_gen_utf8.t
new file mode 100644
index 0000000000..c572c5b4d8
--- /dev/null
+++ b/t/mro/pkg_gen_utf8.t
@@ -0,0 +1,44 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+
+chdir 't' if -d 't';
+require q(./test.pl); plan(tests => 7);
+
+require mro;
+
+{
+ package ᕘ;
+ our @ISA = qw//;
+}
+
+ok(!mro::get_pkg_gen('레알ឭ되s놑Eξsᴛ'),
+ "pkg_gen 0 for non-existent pkg");
+
+my $f_gen = mro::get_pkg_gen('ᕘ');
+ok($f_gen > 0, 'ᕘ pkg_gen > 0');
+
+{
+ no warnings 'once';
+ *ᕘ::ᕘ_Ƒ운ℭ = sub { 123 };
+}
+my $new_f_gen = mro::get_pkg_gen('ᕘ');
+ok($new_f_gen > $f_gen, 'ᕘ pkg_gen incs for methods');
+$f_gen = $new_f_gen;
+
+@ᕘ::ISA = qw/Bar/;
+$new_f_gen = mro::get_pkg_gen('ᕘ');
+ok($new_f_gen > $f_gen, 'ᕘ pkg_gen incs for @ISA');
+
+undef %ᕘ::;
+is(mro::get_pkg_gen('ᕘ'), 1, "pkg_gen 1 for undef %Pkg::");
+
+delete $::{"ᕘ::"};
+is(mro::get_pkg_gen('ᕘ'), 0, 'pkg_gen 0 for delete $::{Pkg::}');
+
+delete $::{"ㄑଊx::"};
+push @ㄑଊx::ISA, "Woot"; # should not segfault
+ok(1, "No segfault on modification of ISA in a deleted stash");
diff --git a/t/mro/recursion_c3_utf8.t b/t/mro/recursion_c3_utf8.t
new file mode 100644
index 0000000000..3abc136f72
--- /dev/null
+++ b/t/mro/recursion_c3_utf8.t
@@ -0,0 +1,102 @@
+#!./perl
+
+use strict;
+use warnings;
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+use utf8;
+use open qw( :utf8 :std );
+
+require './test.pl';
+
+plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
+plan(tests => 8);
+
+require mro;
+
+=pod
+
+These are like the 010_complex_merge_classless test,
+but an infinite loop has been made in the heirarchy,
+to test that we can fail cleanly instead of going
+into an infinite loop
+
+=cut
+
+# initial setup, everything sane
+{
+ package ƙ;
+ use mro 'c3';
+ our @ISA = qw/ᶨ ィ/;
+ package ᶨ;
+ use mro 'c3';
+ our @ISA = qw/f/;
+ package ィ;
+ use mro 'c3';
+ our @ISA = qw/ʰ f/;
+ package ʰ;
+ use mro 'c3';
+ our @ISA = qw/ᶢ/;
+ package ᶢ;
+ use mro 'c3';
+ our @ISA = qw/ᛞ/;
+ package f;
+ use mro 'c3';
+ our @ISA = qw/ǝ/;
+ package ǝ;
+ use mro 'c3';
+ our @ISA = qw/ᛞ/;
+ package ᛞ;
+ use mro 'c3';
+ our @ISA = qw/Ạ B ʗ/;
+ package ʗ;
+ use mro 'c3';
+ our @ISA = qw//;
+ package B;
+ use mro 'c3';
+ our @ISA = qw//;
+ package Ạ;
+ use mro 'c3';
+ our @ISA = qw//;
+}
+
+# A series of 8 aberations that would cause infinite loops,
+# each one undoing the work of the previous
+my @loopies = (
+ sub { @ǝ::ISA = qw/f/ },
+ sub { @ǝ::ISA = qw/ᛞ/; @ʗ::ISA = qw/f/ },
+ sub { @ʗ::ISA = qw//; @Ạ::ISA = qw/ƙ/ },
+ sub { @Ạ::ISA = qw//; @ᶨ::ISA = qw/f ƙ/ },
+ sub { @ᶨ::ISA = qw/f/; @ʰ::ISA = qw/ƙ ᶢ/ },
+ sub { @ʰ::ISA = qw/ᶢ/; @B::ISA = qw/B/ },
+ sub { @B::ISA = qw//; @ƙ::ISA = qw/ƙ ᶨ ィ/ },
+ sub { @ƙ::ISA = qw/ᶨ ィ/; @ᛞ::ISA = qw/Ạ ʰ B ʗ/ },
+);
+
+foreach my $loopy (@loopies) {
+ eval {
+ local $SIG{ALRM} = sub { die "ALRMTimeout" };
+ alarm(3);
+ $loopy->();
+ mro::get_linear_isa('ƙ', 'c3');
+ };
+
+ if(my $err = $@) {
+ if($err =~ /ALRMTimeout/) {
+ ok(0, "Loop terminated by SIGALRM");
+ }
+ elsif($err =~ /Recursive inheritance detected/) {
+ ok(1, "Graceful exception thrown");
+ }
+ else {
+ ok(0, "Unrecognized exception: $err");
+ }
+ }
+ else {
+ ok(0, "Infinite loop apparently succeeded???");
+ }
+}
diff --git a/t/mro/recursion_dfs_utf8.t b/t/mro/recursion_dfs_utf8.t
new file mode 100644
index 0000000000..6b428e1de3
--- /dev/null
+++ b/t/mro/recursion_dfs_utf8.t
@@ -0,0 +1,89 @@
+#!./perl
+
+use strict;
+use warnings;
+BEGIN {
+ unless (-d 'blib') {
+ chdir 't' if -d 't';
+ @INC = '../lib';
+ }
+}
+use utf8;
+use open qw( :utf8 :std );
+
+require './test.pl';
+
+plan(skip_all => "Your system has no SIGALRM") if !exists $SIG{ALRM};
+plan(tests => 8);
+
+=pod
+
+These are like the 010_complex_merge_classless test,
+but an infinite loop has been made in the heirarchy,
+to test that we can fail cleanly instead of going
+into an infinite loop
+
+=cut
+
+# initial setup, everything sane
+{
+ package ƙ;
+ our @ISA = qw/ᶨ ィ/;
+ package ᶨ;
+ our @ISA = qw/f/;
+ package ィ;
+ our @ISA = qw/ʰ f/;
+ package ʰ;
+ our @ISA = qw/ᶢ/;
+ package ᶢ;
+ our @ISA = qw/ᛞ/;
+ package f;
+ our @ISA = qw/ǝ/;
+ package ǝ;
+ our @ISA = qw/ᛞ/;
+ package ᛞ;
+ our @ISA = qw/Ạ B ʗ/;
+ package ʗ;
+ our @ISA = qw//;
+ package B;
+ our @ISA = qw//;
+ package Ạ;
+ our @ISA = qw//;
+}
+
+# A series of 8 aberations that would cause infinite loops,
+# each one undoing the work of the previous
+my @loopies = (
+ sub { @ǝ::ISA = qw/f/ },
+ sub { @ǝ::ISA = qw/ᛞ/; @ʗ::ISA = qw/f/ },
+ sub { @ʗ::ISA = qw//; @Ạ::ISA = qw/ƙ/ },
+ sub { @Ạ::ISA = qw//; @ᶨ::ISA = qw/f ƙ/ },
+ sub { @ᶨ::ISA = qw/f/; @ʰ::ISA = qw/ƙ ᶢ/ },
+ sub { @ʰ::ISA = qw/ᶢ/; @B::ISA = qw/B/ },
+ sub { @B::ISA = qw//; @ƙ::ISA = qw/ƙ ᶨ ィ/ },
+ sub { @ƙ::ISA = qw/ᶨ ィ/; @ᛞ::ISA = qw/Ạ ʰ B ʗ/ },
+);
+
+foreach my $loopy (@loopies) {
+ eval {
+ local $SIG{ALRM} = sub { die "ALRMTimeout" };
+ alarm(3);
+ $loopy->();
+ mro::get_linear_isa('ƙ', 'dfs');
+ };
+
+ if(my $err = $@) {
+ if($err =~ /ALRMTimeout/) {
+ ok(0, "Loop terminated by SIGALRM");
+ }
+ elsif($err =~ /Recursive inheritance detected/) {
+ ok(1, "Graceful exception thrown");
+ }
+ else {
+ ok(0, "Unrecognized exception: $err");
+ }
+ }
+ else {
+ ok(0, "Infinite loop apparently succeeded???");
+ }
+}
diff --git a/t/mro/vulcan_c3_utf8.t b/t/mro/vulcan_c3_utf8.t
new file mode 100644
index 0000000000..68eb12ad95
--- /dev/null
+++ b/t/mro/vulcan_c3_utf8.t
@@ -0,0 +1,67 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+require q(./test.pl); plan(tests => 1);
+
+=pod
+
+example taken from: L<http://www.opendylan.org/books/drm/Method_Dispatch>
+
+ 옵젳Ṯ
+ ^
+ |
+ ᓕᵮꡠFᚖᶭ
+ ^ ^
+ / \
+ SㄣチenŦ 빞엗ᱞ
+ ^ ^
+ | |
+ ᕟ텔li겐ț Hʉ만ӫ읻
+ ^ ^
+ \ /
+ ቩᓪ찬
+
+ define class <SㄣチenŦ> (<ᓕᵮꡠFᚖᶭ>) end class;
+ define class <빞엗ᱞ> (<ᓕᵮꡠFᚖᶭ>) end class;
+ define class <ᕟ텔li겐ț> (<SㄣチenŦ>) end class;
+ define class <Hʉ만ӫ읻> (<빞엗ᱞ>) end class;
+ define class <ቩᓪ찬> (<ᕟ텔li겐ț>, <Hʉ만ӫ읻>) end class;
+
+=cut
+
+{
+ package 옵젳Ṯ;
+ use mro 'c3';
+
+ package ᓕᵮꡠFᚖᶭ;
+ use mro 'c3';
+ use base '옵젳Ṯ';
+
+ package SㄣチenŦ;
+ use mro 'c3';
+ use base 'ᓕᵮꡠFᚖᶭ';
+
+ package 빞엗ᱞ;
+ use mro 'c3';
+ use base 'ᓕᵮꡠFᚖᶭ';
+
+ package ᕟ텔li겐ț;
+ use mro 'c3';
+ use base 'SㄣチenŦ';
+
+ package Hʉ만ӫ읻;
+ use mro 'c3';
+ use base '빞엗ᱞ';
+
+ package ቩᓪ찬;
+ use mro 'c3';
+ use base ('ᕟ텔li겐ț', 'Hʉ만ӫ읻');
+}
+
+ok(eq_array(
+ mro::get_linear_isa('ቩᓪ찬'),
+ [ qw(ቩᓪ찬 ᕟ텔li겐ț SㄣチenŦ Hʉ만ӫ읻 빞엗ᱞ ᓕᵮꡠFᚖᶭ 옵젳Ṯ) ]
+), '... got the right MRO for the ቩᓪ찬 Dylan Example');
diff --git a/t/mro/vulcan_dfs_utf8.t b/t/mro/vulcan_dfs_utf8.t
new file mode 100644
index 0000000000..92ab9dde9f
--- /dev/null
+++ b/t/mro/vulcan_dfs_utf8.t
@@ -0,0 +1,68 @@
+#!./perl
+
+use strict;
+use warnings;
+use utf8;
+use open qw( :utf8 :std );
+require q(./test.pl); plan(tests => 1);
+
+
+=pod
+
+example taken from: L<http://www.opendylan.org/books/drm/Method_Dispatch>
+
+ 옵젳Ṯ
+ ^
+ |
+ ᓕᵮꡠFᚖᶭ
+ ^ ^
+ / \
+ SㄣチenŦ 빞엗ᱞ
+ ^ ^
+ | |
+ ᕟ텔li겐ț Hʉ만ӫ읻
+ ^ ^
+ \ /
+ ቩᓪ찬
+
+ define class <SㄣチenŦ> (<life-form>) end class;
+ define class <빞엗ᱞ> (<life-form>) end class;
+ define class <ᕟ텔li겐ț> (<SㄣチenŦ>) end class;
+ define class <Hʉ만ӫ읻> (<빞엗ᱞ>) end class;
+ define class <ቩᓪ찬> (<ᕟ텔li겐ț>, <Hʉ만ӫ읻>) end class;
+
+=cut
+
+{
+ package 옵젳Ṯ;
+ use mro 'dfs';
+
+ package ᓕᵮꡠFᚖᶭ;
+ use mro 'dfs';
+ use base '옵젳Ṯ';
+
+ package SㄣチenŦ;
+ use mro 'dfs';
+ use base 'ᓕᵮꡠFᚖᶭ';
+
+ package 빞엗ᱞ;
+ use mro 'dfs';
+ use base 'ᓕᵮꡠFᚖᶭ';
+
+ package ᕟ텔li겐ț;
+ use mro 'dfs';
+ use base 'SㄣチenŦ';
+
+ package Hʉ만ӫ읻;
+ use mro 'dfs';
+ use base '빞엗ᱞ';
+
+ package ቩᓪ찬;
+ use mro 'dfs';
+ use base ('ᕟ텔li겐ț', 'Hʉ만ӫ읻');
+}
+
+ok(eq_array(
+ mro::get_linear_isa('ቩᓪ찬'),
+ [ qw(ቩᓪ찬 ᕟ텔li겐ț SㄣチenŦ ᓕᵮꡠFᚖᶭ 옵젳Ṯ Hʉ만ӫ읻 빞엗ᱞ) ]
+), '... got the right MRO for the ቩᓪ찬 Dylan Example');