diff options
author | Brian Fraser <fraserbn@gmail.com> | 2011-07-06 10:41:10 -0300 |
---|---|---|
committer | Father Chrysostomos <sprout@cpan.org> | 2011-10-06 13:01:10 -0700 |
commit | 204e6232679d0d412347fddd9e5bd0e529da73d5 (patch) | |
tree | f277f72f11f914e9b6c9874e5e48c22d56ba27a1 /t/mro/basic_02_dfs_utf8.t | |
parent | a00b390b6689672af8817e28321f92e70369c0d4 (diff) | |
download | perl-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/basic_02_dfs_utf8.t')
-rw-r--r-- | t/mro/basic_02_dfs_utf8.t | 117 |
1 files changed, 117 insertions, 0 deletions
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'); |