From: Stevan Little Date: Tue, 15 Nov 2005 22:41:02 +0000 (+0000) Subject: Class::C3 - overload fix X-Git-Tag: 0_07~1 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=680100b1744c65ae1a1dc2da8522731aa197d75b;p=gitmo%2FClass-C3.git Class::C3 - overload fix --- diff --git a/ChangeLog b/ChangeLog index fc38de9..bb69c86 100644 --- 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 diff --git a/MANIFEST b/MANIFEST index 0897ad6..eff3a5b 100644 --- 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 diff --git a/lib/Class/C3.pm b/lib/Class/C3.pm index ae2635b..6ca3999 100644 --- a/lib/Class/C3.pm +++ b/lib/Class/C3.pm @@ -18,7 +18,8 @@ our $VERSION = '0.06'; # methods => { # orig => , # code => \& -# } +# }, +# 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 index 0000000..e612568 --- /dev/null +++ b/t/21_C3_with_overload.t @@ -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 }