t/mro/next_edgecases_utf8.t

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use warnings;
   5
   6 BEGIN {
   7     chdir 't' if -d 't';
   8     require q(./test.pl);
   9     set_up_inc('../lib', 'lib');
  10 }
  11
  12 use utf8;
  13 use open qw( :utf8 :std );
  14
  15 plan(tests => 12);
  16
  17 {
  18
  19     {
  20         package ᕘ;
  21         use strict;
  22         use warnings;
  23         use mro 'c3';
  24         sub new { bless {}, $_[0] }
  25         sub ƚ { 'ᕘ::ƚ' }
  26     }
  27
  28     # call the submethod in the direct instance
  29
  30     my $foo = ᕘ->new();
  31     object_ok($foo, 'ᕘ');
  32
  33     can_ok($foo, 'ƚ');
  34     is($foo->ƚ(), 'ᕘ::ƚ', '... got the right return value');
  35
  36     # fail calling it from a subclass
  37
  38     {
  39         package Baɾ;
  40         use strict;
  41         use warnings;
  42         use mro 'c3';
  43         our @ISA = ('ᕘ');
  44     }
  45
  46     my $bar = Baɾ->new();
  47     object_ok($bar, 'Baɾ');
  48     object_ok($bar, 'ᕘ');
  49
  50     # test it working with with Sub::Name
  51     SKIP: {
  52         eval 'use Sub::Name';
  53         skip("Sub::Name is required for this test", 3) if $@;
  54
  55         my $m = sub { (shift)->next::method() };
  56         Sub::Name::subname('Baɾ::ƚ', $m);
  57         {
  58             no strict 'refs';
  59             *{'Baɾ::ƚ'} = $m;
  60         }
  61
  62         can_ok($bar, 'ƚ');
  63         my $value = eval { $bar->ƚ() };
  64         ok(!$@, '... calling ƚ() succeeded') || diag $@;
  65         is($value, 'ᕘ::ƚ', '... got the right return value too');
  66     }
  67
  68     # test it failing without Sub::Name
  69     {
  70         package બʑ;
  71         use strict;
  72         use warnings;
  73         use mro 'c3';
  74         our @ISA = ('ᕘ');
  75     }
  76
  77     my $baz = બʑ->new();
  78     object_ok($baz, 'બʑ');
  79     object_ok($baz, 'ᕘ');
  80
  81     {
  82         my $m = sub { (shift)->next::method() };
  83         {
  84             no strict 'refs';
  85             *{'બʑ::ƚ'} = $m;
  86         }
  87
  88         eval { $baz->ƚ() };
  89         ok($@, '... calling ƚ() with next::method failed') || diag $@;
  90     }
  91
  92     # Test with non-existing class (used to segfault)
  93     {
  94         package Qűx;
  95         use mro;
  96         sub fਓ { No::Such::Class->next::can }
  97     }
  98
  99     eval { Qűx->fਓ() };
 100     is($@, '', "->next::can on non-existing package name");
 101
 102 }