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