From: Dave Rolsky Date: Thu, 7 Aug 2008 16:48:21 +0000 (+0000) Subject: More tests for unimport to make sure it _really_ acts like it used X-Git-Tag: 0_55_01~43^2~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b30e77816596b068e87f74e4113362719cb1a71e;p=gitmo%2FMoose.git More tests for unimport to make sure it _really_ acts like it used to. This particular problem was turned up by the MX::Singleton test suite. --- diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm index 193d815..f6cea34 100644 --- a/lib/Moose/Exporter.pm +++ b/lib/Moose/Exporter.pm @@ -32,7 +32,7 @@ sub build_import_methods { my $import = $class->_make_import_sub( $exporter, \@exports_from ); - my $unimport = $class->_make_unimport_sub( [ keys %{$exports} ] ); + my $unimport = $class->_make_unimport_sub( \@exports_from, [ keys %{$exports} ] ); no strict 'refs'; *{ $exporting_package . '::import' } = $import; @@ -202,20 +202,29 @@ sub _get_caller { } sub _make_unimport_sub { - my $class = shift; - my $exported = shift; + shift; + my $sources = shift; + my $keywords = shift; return sub { + my $class = shift; my $caller = scalar caller(); - Moose::Exporter->_remove_keywords( $caller, $exported ); + Moose::Exporter->_remove_keywords( + $caller, + [ $class, @{$sources} ], + $keywords + ); }; } sub _remove_keywords { shift; my $package = shift; + my $sources = shift; my $keywords = shift; + my %sources = map { $_ => 1 } @{$sources}; + no strict 'refs'; # loop through the keywords ... @@ -227,7 +236,7 @@ sub _remove_keywords { # make sure it is from us my ($pkg_name) = Class::MOP::get_code_info($keyword); - next if $pkg_name eq $package; + next unless $sources{$pkg_name}; # and if it is from us, then undef the slot delete ${ $package . '::' }{$name}; diff --git a/t/050_metaclasses/012_moose_exporter.t b/t/050_metaclasses/012_moose_exporter.t index 45c0770..8965d1c 100644 --- a/t/050_metaclasses/012_moose_exporter.t +++ b/t/050_metaclasses/012_moose_exporter.t @@ -3,9 +3,35 @@ use strict; use warnings; -use Test::More tests => 38; +use Test::More; use Test::Exception; +BEGIN { + unless ( eval 'use Test::Warn; 1' ) { + plan skip_all => 'These tests require Test::Warn'; + } + else { + plan tests => 40; + } +} + + +{ + package HasOwnImmutable; + + use Moose; + + no Moose; + + ::warning_is( sub { eval q[sub make_immutable { return 'foo' }] }, + '', + 'no warning when defining our own make_immutable sub' ); +} + +{ + is( HasOwnImmutable->make_immutable(), 'foo', + 'HasOwnImmutable->make_immutable does not get overwritten' ); +} { package MooseX::Empty;