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