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