new overload fallback fixes, matches the behavior of normal overload and overload...

diff --git a/ChangeLog b/ChangeLog
index 547dc58..5913011 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,7 @@ Revision history for Perl extension Class::C3.
 
     - Fix for overloading to method name string,
        from Ittetsu Miyazaki.
+    - Fixed overload fallback edge cases.
 
 0.14 Tues, Sep 19, 2006
     - Fix for rt.cpan.org #21558

diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm
index cb775b6..5b633d5 100644 (file)
--- a/lib/Class/C3.pm
+++ b/lib/Class/C3.pm
@@ -82,7 +82,7 @@ sub _calculate_method_dispatch_table {
     no strict 'refs';
     my @MRO = calculateMRO($class, $merge_cache);
     $MRO{$class} = { MRO => \@MRO };
-    my $has_overload_fallback = 0;
+    my $has_overload_fallback;
     my %methods;
     # NOTE: 
     # we do @MRO[1 .. $#MRO] here because it
@@ -93,7 +93,7 @@ sub _calculate_method_dispatch_table {
         # have use "fallback", then we want to
         # grab that value 
         $has_overload_fallback = ${"${local}::()"} 
-            if defined ${"${local}::()"};
+            if !defined $has_overload_fallback && defined ${"${local}::()"};
         foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
             # skip if already overriden in local class
             next unless !defined *{"${class}::$method"}{CODE};
@@ -118,7 +118,8 @@ sub _apply_method_dispatch_table {
     my $class = shift;
     no strict 'refs';
     ${"${class}::()"} = $MRO{$class}->{has_overload_fallback}
-        if $MRO{$class}->{has_overload_fallback};
+        if !defined &{"${class}::()"}
+           && defined $MRO{$class}->{has_overload_fallback};
     foreach my $method (keys %{$MRO{$class}->{methods}}) {
         if ( $method =~ /^\(/ ) {
             my $orig = $MRO{$class}->{methods}->{$method}->{orig};

diff --git a/t/24_more_overload.t b/t/24_more_overload.t
new file mode 100644 (file)
index 0000000..d02c8de
--- /dev/null
+++ b/t/24_more_overload.t
@@ -0,0 +1,67 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+BEGIN {
+    use_ok('Class::C3');
+}
+
+{
+    package BaseTest;
+    use Class::C3;
+    sub new { bless {} => shift }    
+    
+    package OverloadingTest;
+    use Class::C3;
+    use base 'BaseTest';        
+    use overload '+'  => sub { die "called plus operator in OT" },
+                 fallback => 0;
+    
+    package InheritingFromOverloadedTest;
+    use base 'OverloadingTest';
+    use Class::C3;
+    use overload '+'  => sub { die "called plus operator in IFOT" },
+                 fallback => 1;
+
+    package IFOTX;
+    use Class::C3;
+    use base 'OverloadingTest';
+
+    package IFIFOT;
+    use Class::C3;
+    use base 'InheritingFromOverloadedTest';
+
+    package Foo;
+    use Class::C3;
+    use base 'BaseTest';
+    use overload '+'  => sub { die "called plus operator in Foo" },
+                 fallback => 1;
+
+    package Bar;
+    use Class::C3;
+    use base 'Foo';
+    use overload '+'  => sub { die "called plus operator in Bar" },
+                 fallback => 0;
+
+    package Baz;
+    use Class::C3;
+    use base 'Bar';
+}
+
+Class::C3::initialize();
+
+my $x = IFOTX->new();
+eval { $x += 1 };
+like($@, qr/no method found,/);
+
+my $y = IFIFOT->new();
+eval { $y += 1 };
+like($@, qr/called plus operator in IFOT/);
+
+my $z = Baz->new();
+eval { $z += 1 };
+like($@, qr/no method found,/);
+