From: Stevan Little Date: Wed, 28 Dec 2005 18:03:36 +0000 (+0000) Subject: whoops X-Git-Tag: 0_10~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5dd9299c18bd54f97408f6580abca725e937d6ac;p=gitmo%2FClass-C3.git whoops --- diff --git a/MANIFEST b/MANIFEST index cfd58d1..ea660ca 100644 --- a/MANIFEST +++ b/MANIFEST @@ -14,6 +14,7 @@ t/06_MRO.t t/10_Inconsistent_hierarchy.t t/20_reinitialize.t t/21_C3_with_overload.t +t/22_uninitialize.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 9d5a1d7..6a23d4d 100644 --- a/lib/Class/C3.pm +++ b/lib/Class/C3.pm @@ -139,9 +139,9 @@ sub _remove_method_dispatch_table { no strict 'refs'; delete ${"${class}::"}{"()"} if $MRO{$class}->{has_overload_fallback}; foreach my $method (keys %{$MRO{$class}->{methods}}) { - delete ${"${class}::"}{$method}; - #if defined ${"${class}::"}{$method}{CODE} && - # ${"${class}::"}{$method}{CODE} eq $MRO{$class}->{methods}->{$method}->{code}; + delete ${"${class}::"}{$method} + if defined *{"${class}::${method}"}{CODE} && + (*{"${class}::${method}"}{CODE} eq $MRO{$class}->{methods}->{$method}->{code}); } } @@ -218,7 +218,6 @@ sub method { last unless $method_caller eq '(eval)'; } my @label = (split '::', $method_caller); - #my @label = (split '::', (caller(1))[3]); my $label = pop @label; my $caller = join '::' => @label; my $self = $_[0]; @@ -479,9 +478,9 @@ module's test suite. ---------------------------- ------ ------ ------ ------ ------ ------ ------ File stmt bran cond sub pod time total ---------------------------- ------ ------ ------ ------ ------ ------ ------ - Class/C3.pm 98.6 88.6 75.0 96.0 100.0 70.4 95.2 + Class/C3.pm 98.6 90.9 73.3 96.0 100.0 96.8 95.3 ---------------------------- ------ ------ ------ ------ ------ ------ ------ - Total 98.6 88.6 75.0 96.0 100.0 70.4 95.2 + Total 98.6 90.9 73.3 96.0 100.0 96.8 95.3 ---------------------------- ------ ------ ------ ------ ------ ------ ------ =head1 SEE ALSO diff --git a/t/22_uninitialize.t b/t/22_uninitialize.t new file mode 100644 index 0000000..e5068d2 --- /dev/null +++ b/t/22_uninitialize.t @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 12; + +BEGIN { + use_ok('Class::C3'); + # uncomment this line, and re-run the + # test to see the normal p5 dispatch order + #$Class::C3::TURN_OFF_C3 = 1; +} + +=pod + + + / \ + + \ / + + +=cut + +{ + package Diamond_A; + use Class::C3; + sub hello { 'Diamond_A::hello' } +} +{ + package Diamond_B; + use base 'Diamond_A'; + use Class::C3; +} +{ + package Diamond_C; + use Class::C3; + use base 'Diamond_A'; + sub goodbye { 'Diamond_C::goodbye' } + sub hello { 'Diamond_C::hello' } +} +{ + package Diamond_D; + use base ('Diamond_B', 'Diamond_C'); + use Class::C3; + + our @hello = qw(h e l l o); + our $hello = 'hello'; + our %hello = (h => 1, e => 2, l => "3 & 4", o => 5) +} + +is(Diamond_D->hello, 'Diamond_C::hello', '... method resolves with the correct MRO'); +is(Diamond_D->goodbye, 'Diamond_C::goodbye', '... method resolves with the correct MRO'); + +{ + no warnings 'redefine'; + no strict 'refs'; + *{"Diamond_D::goodbye"} = sub { 'Diamond_D::goodbye' }; +} + +is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... method overwritten'); + +is($Diamond_D::hello, 'hello', '... our SCALAR package vars are here'); +is_deeply( + \@Diamond_D::hello, + [ qw(h e l l o) ], + '... our ARRAY package vars are here'); +is_deeply( + \%Diamond_D::hello, + { h => 1, e => 2, l => "3 & 4", o => 5 }, + '... our HASH package vars are here'); + +Class::C3::uninitialize(); + +is(Diamond_D->hello, 'Diamond_A::hello', '... method resolves with reinitialized MRO'); +is(Diamond_D->goodbye, 'Diamond_D::goodbye', '... uninitialize does not mess with the manually changed method'); + +is($Diamond_D::hello, 'hello', '... our SCALAR package vars are still here'); +is_deeply( + \@Diamond_D::hello, + [ qw(h e l l o) ], + '... our ARRAY package vars are still here'); +is_deeply( + \%Diamond_D::hello, + { h => 1, e => 2, l => "3 & 4", o => 5 }, + '... our HASH package vars are still here'); +