t/mro/isa_dfs_utf8.t

   1 #!perl -w
   2
   3 BEGIN {
   4     chdir 't' if -d 't';
   5     require "./test.pl";
   6     set_up_inc('../lib');
   7 }
   8
   9 use strict;
  10 use utf8;
  11 use open qw( :utf8 :std );
  12
  13 plan 'no_plan';
  14
  15 # package klonk doesn't have a stash.
  16
  17 package 캎oẃ;
  18
  19 # No parents
  20
  21 package urḲḵｋ;
  22
  23 # 1 parent
  24 @urḲḵｋ::ISA = 'kഌoんḰ';
  25
  26 package к;
  27
  28 # 2 parents
  29 @urḲḵｋ::ISA = ('kഌoんḰ', '캎oẃ');
  30
  31 package ṭ화ckэ;
  32
  33 # No parents, has @ISA
  34 @ṭ화ckэ::ISA = ();
  35
  36 package Źzzzዟᑉ;
  37
  38 @Źzzzዟᑉ::ISA = ('ṭ화ckэ', '캎oẃ');
  39
  40 package Ẁ함Ｍ;
  41
  42 @Ẁ함Ｍ::ISA = ('캎oẃ', 'ṭ화ckэ');
  43
  44 package main;
  45
  46 require mro;
  47
  48 my %expect =
  49     (
  50      kഌoんḰ => [qw(kഌoんḰ)],
  51      urḲḵｋ => [qw(urḲḵｋ kഌoんḰ 캎oẃ)],
  52      캎oẃ => [qw(캎oẃ)],
  53      к => [qw(к)],
  54      ṭ화ckэ => [qw(ṭ화ckэ)],
  55      Źzzzዟᑉ => [qw(Źzzzዟᑉ ṭ화ckэ 캎oẃ)],
  56      Ẁ함Ｍ => [qw(Ẁ함Ｍ 캎oẃ ṭ화ckэ)],
  57     );
  58
  59 foreach my $package (qw(kഌoんḰ urḲḵｋ 캎oẃ к ṭ화ckэ Źzzzዟᑉ Ẁ함Ｍ)) {
  60     my $ref = bless [], $package;
  61     my $isa = $expect{$package};
  62     is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
  63
  64     foreach my $class ($package, @$isa, 'UNIVERSAL') {
  65         object_ok($ref, $class, $package);
  66     }
  67 }