Merge 'trunk' into 'Class-C3-PurePerl'

r30755@brandon-blacks-computer (orig r2234):  blblack | 2007-04-30 18:35:11 -0500
new overload fallback fixes, matches the behavior of normal overload and overload+c3 in blead

diff --git a/ChangeLog b/ChangeLog
index 92778f9..888c1bb 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,7 @@
 Revision history for Perl extension Class::C3.
 
+    - Fixed overload fallback edge cases.
+
 0.15_05 Thurs, Apr 19, 2007
     - Patch is in the latest perl-current now,
       and this dev release assumes 5.9.5 has the patch

diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm
index fb7c58b..30e8736 100644 (file)
--- a/lib/Class/C3.pm
+++ b/lib/Class/C3.pm
@@ -114,7 +114,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
@@ -125,7 +125,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};
@@ -152,7 +152,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,/);
+