1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use Test::More tests => 12; 7 8BEGIN { use_ok('Class::C3::XS') } 9 10{ 11 12 { 13 package Foo; 14 use strict; 15 use warnings; 16 sub new { bless {}, $_[0] } 17 sub bar { 'Foo::bar' } 18 } 19 20 # call the submethod in the direct instance 21 22 my $foo = Foo->new(); 23 isa_ok($foo, 'Foo'); 24 25 can_ok($foo, 'bar'); 26 is($foo->bar(), 'Foo::bar', '... got the right return value'); 27 28 # fail calling it from a subclass 29 30 { 31 package Bar; 32 use strict; 33 use warnings; 34 our @ISA = ('Foo'); 35 } 36 37 my $bar = Bar->new(); 38 isa_ok($bar, 'Bar'); 39 isa_ok($bar, 'Foo'); 40 41 # test it working with with Sub::Name 42 SKIP: { 43 eval 'use Sub::Name'; 44 skip "Sub::Name is required for this test", 3 if $@; 45 46 my $m = sub { (shift)->next::method() }; 47 Sub::Name::subname('Bar::bar', $m); 48 { 49 no strict 'refs'; 50 *{'Bar::bar'} = $m; 51 } 52 53 can_ok($bar, 'bar'); 54 my $value = eval { $bar->bar() }; 55 ok(!$@, '... calling bar() succedded') || diag $@; 56 is($value, 'Foo::bar', '... got the right return value too'); 57 } 58 59 # test it failing without Sub::Name 60 { 61 package Baz; 62 use strict; 63 use warnings; 64 our @ISA = ('Foo'); 65 } 66 67 my $baz = Baz->new(); 68 isa_ok($baz, 'Baz'); 69 isa_ok($baz, 'Foo'); 70 71 { 72 my $m = sub { (shift)->next::method() }; 73 { 74 no strict 'refs'; 75 *{'Baz::bar'} = $m; 76 } 77 78 eval { $baz->bar() }; 79 ok($@, '... calling bar() with next::method failed') || diag $@; 80 } 81} 82