Class::C3 - 0.05 release
[gitmo/Class-C3.git] / t / 32_next_method_edge_cases.t
diff --git a/t/32_next_method_edge_cases.t b/t/32_next_method_edge_cases.t
new file mode 100644 (file)
index 0000000..4f85e74
--- /dev/null
@@ -0,0 +1,58 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 9;
+
+BEGIN {   
+    use_ok('Class::C3');
+}
+
+{
+
+    {
+        package Foo;
+        use strict;
+        use warnings;
+        use Class::C3;
+        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;
+        use Class::C3;
+        our @ISA = ('Foo');
+    }
+    
+    use Sub::Name;
+    
+    my $m = sub { (shift)->next::method() };
+    subname('Bar::bar', $m);
+    {
+        no strict 'refs';
+        *{'Bar::bar'} = $m;
+    }
+
+    my $bar = Bar->new();
+    isa_ok($bar, 'Bar');
+    isa_ok($bar, 'Foo');
+
+    can_ok($bar, 'bar');
+    my $value = eval { $bar->bar() };
+    ok(!$@, '... calling bar() succedded') || diag $@;
+    is($value, 'Foo::bar', '... got the right return value too');
+}
\ No newline at end of file