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