More tests for unimport to make sure it _really_ acts like it used
Dave Rolsky [Thu, 7 Aug 2008 16:48:21 +0000 (16:48 +0000)]
to. This particular problem was turned up by the MX::Singleton test
suite.

lib/Moose/Exporter.pm
t/050_metaclasses/012_moose_exporter.t

index 193d815..f6cea34 100644 (file)
@@ -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};
index 45c0770..8965d1c 100644 (file)
@@ -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;