Class::C3 - overload fix
Stevan Little [Tue, 15 Nov 2005 22:41:02 +0000 (22:41 +0000)]
ChangeLog
MANIFEST
lib/Class/C3.pm
t/21_C3_with_overload.t [new file with mode: 0644]

index fc38de9..bb69c86 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -5,6 +5,9 @@ Revision history for Perl extension Class::C3.
       just for the tests)
     - removed OS X resource fork which slipped into the tar.gz
     - improved error reporting for Inconsistent Hierarchies
+    - added feature to insure that Overload "fallback" setting
+      is properly inherited
+        - added test for this
 
 0.05 - Mon, Nov 14, 2005
     - added caching to next::method, courtesy of quicksilver
index 0897ad6..eff3a5b 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -12,6 +12,7 @@ t/04_MRO.t
 t/05_MRO.t
 t/10_Inconsistent_hierarchy.t
 t/20_reinitialize.t
+t/21_C3_with_overload.t
 t/30_next_method.t
 t/31_next_method_skip.t
 t/32_next_method_edge_cases.t
index ae2635b..6ca3999 100644 (file)
@@ -18,7 +18,8 @@ our $VERSION = '0.06';
 #      methods => {
 #          orig => <original location of method>,
 #          code => \&<ref to original method>
-#      }
+#      },
+#      has_overload_fallback => (1 | 0)
 #   }
 #
 my %MRO;
@@ -85,12 +86,18 @@ sub _calculate_method_dispatch_table {
     no strict 'refs';
     my @MRO = calculateMRO($class);
     $MRO{$class} = { MRO => \@MRO };
+    my $has_overload_fallback = 0;
     my %methods;
     # NOTE: 
     # we do @MRO[1 .. $#MRO] here because it
     # makes no sense to interogate the class
     # which you are calculating for. 
     foreach my $local (@MRO[1 .. $#MRO]) {
+        # if overload has tagged this module to 
+        # have use "fallback", then we want to
+        # grab that value 
+        $has_overload_fallback = ${"${local}::()"} 
+            if defined ${"${local}::()"};
         foreach my $method (grep { defined &{"${local}::$_"} } keys %{"${local}::"}) {
             # skip if already overriden in local class
             next unless !defined *{"${class}::$method"}{CODE};
@@ -101,7 +108,8 @@ sub _calculate_method_dispatch_table {
         }
     }    
     # now stash them in our %MRO table
-    $MRO{$class}->{methods} = \%methods;    
+    $MRO{$class}->{methods} = \%methods; 
+    $MRO{$class}->{has_overload_fallback} = $has_overload_fallback;        
 }
 
 sub _apply_method_dispatch_tables {
@@ -113,6 +121,8 @@ sub _apply_method_dispatch_tables {
 sub _apply_method_dispatch_table {
     my $class = shift;
     no strict 'refs';
+    ${"${class}::()"} = $MRO{$class}->{has_overload_fallback}
+        if $MRO{$class}->{has_overload_fallback};
     foreach my $method (keys %{$MRO{$class}->{methods}}) {
         *{"${class}::$method"} = $MRO{$class}->{methods}->{$method}->{code};
     }    
@@ -127,6 +137,7 @@ sub _remove_method_dispatch_tables {
 sub _remove_method_dispatch_table {
     my $class = shift;
     no strict 'refs';
+    delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback};    
     foreach my $method (keys %{$MRO{$class}->{methods}}) {
         delete ${"${class}::"}{$method};
     }   
diff --git a/t/21_C3_with_overload.t b/t/21_C3_with_overload.t
new file mode 100644 (file)
index 0000000..e612568
--- /dev/null
@@ -0,0 +1,54 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 8;
+
+BEGIN {
+    use_ok('Class::C3');
+}
+
+{
+    package BaseTest;
+    use strict;
+    use warnings;
+    use Class::C3;
+    
+    package OverloadingTest;
+    use strict;
+    use warnings;
+    use Class::C3;
+    use base 'BaseTest';        
+    use overload '""' => sub { ref(shift) . " stringified" },
+                 fallback => 1;
+    
+    sub new { bless {} => shift }    
+    
+    package InheritingFromOverloadedTest;
+    use strict;
+    use warnings;
+    use base 'OverloadingTest';
+    use Class::C3;
+}
+
+my $x = InheritingFromOverloadedTest->new();
+isa_ok($x, 'InheritingFromOverloadedTest');
+
+my $y = OverloadingTest->new();
+isa_ok($y, 'OverloadingTest');
+
+is("$x", 'InheritingFromOverloadedTest stringified', '... got the right value when stringifing');
+is("$y", 'OverloadingTest stringified', '... got the right value when stringifing');
+
+ok(($y eq 'OverloadingTest stringified'), '... eq was handled correctly');
+
+my $result;
+eval { 
+    $result = $x eq 'InheritingFromOverloadedTest stringified' 
+};
+ok(!$@, '... this should not throw an exception');
+ok($result, '... and we should get the true value');
+
+#use Data::Dumper;
+#diag Dumper { Class::C3::_dump_MRO_table }