1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
6BEGIN {
7    chdir 't' if -d 't';
8    require q(./test.pl);
9    set_up_inc('../lib', 'lib');
10}
11
12use utf8;
13use open qw( :utf8 :std );
14
15plan(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 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}
103