t/mro/pkg_gen_utf8.t

   1 #!./perl
   2
   3 use strict;
   4 use warnings;
   5 use utf8;
   6 use open qw( :utf8 :std );
   7
   8 chdir 't' if -d 't';
   9 require q(./test.pl); plan(tests => 7);
  10
  11 require mro;
  12
  13 {
  14     package ᕘ;
  15     our @ISA = qw//;
  16 }
  17
  18 ok(!mro::get_pkg_gen('레알ឭ되s놑Eξsᴛ'),
  19     "pkg_gen 0 for non-existent pkg");
  20
  21 my $f_gen = mro::get_pkg_gen('ᕘ');
  22 ok($f_gen > 0, 'ᕘ pkg_gen > 0');
  23
  24 {
  25     no warnings 'once';
  26     *ᕘ::ᕘ_Ƒ운ℭ = sub { 123 };
  27 }
  28 my $new_f_gen = mro::get_pkg_gen('ᕘ');
  29 ok($new_f_gen > $f_gen, 'ᕘ pkg_gen incs for methods');
  30 $f_gen = $new_f_gen;
  31
  32 @ᕘ::ISA = qw/Bar/;
  33 $new_f_gen = mro::get_pkg_gen('ᕘ');
  34 ok($new_f_gen > $f_gen, 'ᕘ pkg_gen incs for @ISA');
  35
  36 undef %ᕘ::;
  37 is(mro::get_pkg_gen('ᕘ'), 1, "pkg_gen 1 for undef %Pkg::");
  38
  39 delete $::{"ᕘ::"};
  40 is(mro::get_pkg_gen('ᕘ'), 0, 'pkg_gen 0 for delete $::{Pkg::}');
  41
  42 delete $::{"ㄑଊｘ::"};
  43 push @ㄑଊｘ::ISA, "Woot"; # should not segfault
  44 ok(1, "No segfault on modification of ISA in a deleted stash");