This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
mg.c: Remove poorly considered assertion
[perl5.git] / t / mro / next_edgecases_utf8.t
CommitLineData
204e6232
BF
1#!/usr/bin/perl
2
3use strict;
4use warnings;
5
a817e89d 6BEGIN { chdir 't' if -d 't'; require q(./test.pl); @INC = qw "../lib lib" }
204e6232
BF
7
8use utf8;
9use open qw( :utf8 :std );
10
11plan(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();
bbce3ca6 27 object_ok($foo, 'ᕘ');
204e6232
BF
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();
bbce3ca6
MS
43 object_ok($bar, 'Baɾ');
44 object_ok($bar, 'ᕘ');
204e6232
BF
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();
bbce3ca6
MS
74 object_ok($baz, 'બʑ');
75 object_ok($baz, 'ᕘ');
204e6232
BF
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}