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