X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F32_next_method_edge_cases.t;fp=t%2F32_next_method_edge_cases.t;h=422f134d4404c176c2ad2e2c9b80a21bb6b4c2b3;hb=2605e5915fb1dc1d8cd98585f16cb57d1df11c5b;hp=0000000000000000000000000000000000000000;hpb=267c5382960413d75d338c91751f7093ec4987d3;p=gitmo%2FClass-C3-XS.git

diff --git a/t/32_next_method_edge_cases.t b/t/32_next_method_edge_cases.t
new file mode 100644
index 0000000..422f134
--- /dev/null
+++ b/t/32_next_method_edge_cases.t
@@ -0,0 +1,81 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 12;
+
+BEGIN { use_ok('Class::C3::XS') }
+
+{
+
+    {
+        package Foo;
+        use strict;
+        use warnings;
+        sub new { bless {}, $_[0] }
+        sub bar { 'Foo::bar' }
+    }
+
+    # call the submethod in the direct instance
+
+    my $foo = Foo->new();
+    isa_ok($foo, 'Foo');
+
+    can_ok($foo, 'bar');
+    is($foo->bar(), 'Foo::bar', '... got the right return value');    
+
+    # fail calling it from a subclass
+
+    {
+        package Bar;
+        use strict;
+        use warnings;
+        our @ISA = ('Foo');
+    }  
+    
+    my $bar = Bar->new();
+    isa_ok($bar, 'Bar');
+    isa_ok($bar, 'Foo');    
+    
+    # test it working with with Sub::Name
+    SKIP: {    
+        eval 'use Sub::Name';
+        skip "Sub::Name is required for this test", 3 if $@;
+    
+        my $m = sub { (shift)->next::method() };
+        Sub::Name::subname('Bar::bar', $m);
+        {
+            no strict 'refs';
+            *{'Bar::bar'} = $m;
+        }
+
+        can_ok($bar, 'bar');
+        my $value = eval { $bar->bar() };
+        ok(!$@, '... calling bar() succedded') || diag $@;
+        is($value, 'Foo::bar', '... got the right return value too');
+    }
+    
+    # test it failing without Sub::Name
+    {
+        package Baz;
+        use strict;
+        use warnings;
+        our @ISA = ('Foo');
+    }      
+    
+    my $baz = Baz->new();
+    isa_ok($baz, 'Baz');
+    isa_ok($baz, 'Foo');    
+    
+    {
+        my $m = sub { (shift)->next::method() };
+        {
+            no strict 'refs';
+            *{'Baz::bar'} = $m;
+        }
+
+        eval { $baz->bar() };
+        ok($@, '... calling bar() with next::method failed') || diag $@;
+    }    
+}