From: Dave Rolsky <autarch@urth.org>
Date: Thu, 14 Aug 2008 14:26:16 +0000 (+0000)
Subject: More tests & fixes for the goto &Moose::import case.
X-Git-Tag: 0_55_01~21
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12fd2648b5fdbf05fe562bc87e426d52b0ae4a5f;p=gitmo%2FMoose.git

More tests & fixes for the goto &Moose::import case.

When this happens, the first argument to Moose::import is the original
package (Squirrel, etc). Arguably, this means that doing this goto
stuff is wrong, but it's easy enough to ignore this, since we know
what the real package is when we construct the import & unimport subs.
---

diff --git a/lib/Moose/Exporter.pm b/lib/Moose/Exporter.pm
index 3f96443..5c32a6b 100644
--- a/lib/Moose/Exporter.pm
+++ b/lib/Moose/Exporter.pm
@@ -45,9 +45,12 @@ sub build_import_methods {
     # $args{_export_to_main} exists for backwards compat, because
     # Moose::Util::TypeConstraints did export to main (unlike Moose &
     # Moose::Role).
-    my $import = $class->_make_import_sub( $exporter, \@exports_from, $args{_export_to_main} );
+    my $import = $class->_make_import_sub( $exporting_package, $exporter,
+        \@exports_from, $args{_export_to_main} );
 
-    my $unimport = $class->_make_unimport_sub( \@exports_from, [ keys %{$exports} ] );
+    my $unimport
+        = $class->_make_unimport_sub( $exporting_package, \@exports_from,
+        [ keys %{$exports} ] );
 
     return ( $import, $unimport )
 }
@@ -165,9 +168,10 @@ sub _make_sub_exporter_params {
 
     sub _make_import_sub {
         shift;
-        my $exporter       = shift;
-        my $exports_from   = shift;
-        my $export_to_main = shift;
+        my $exporting_package = shift;
+        my $exporter          = shift;
+        my $exports_from      = shift;
+        my $export_to_main    = shift;
 
         return sub {
             # I think we could use Sub::Exporter's collector feature
@@ -181,9 +185,10 @@ sub _make_sub_exporter_params {
             my $traits;
             ($traits, @_) = Moose::Exporter::_strip_traits(@_);
 
-            # It's important to leave @_ as-is for the benefit of
-            # Sub::Exporter.
-            my $class = $_[0];
+            # Normally we could look at $_[0], but in some weird cases
+            # (involving goto &Moose::import), $_[0] ends as something
+            # else (like Squirrel).
+            my $class = $exporting_package;
 
             $CALLER = Moose::Exporter::_get_caller(@_);
 
@@ -281,15 +286,15 @@ sub _get_caller {
 
 sub _make_unimport_sub {
     shift;
-    my $sources  = shift;
-    my $keywords = shift;
+    my $exporting_package = shift;
+    my $sources           = shift;
+    my $keywords          = shift;
 
     return sub {
-        my $class  = shift;
         my $caller = scalar caller();
         Moose::Exporter->_remove_keywords(
             $caller,
-            [ $class, @{$sources} ],
+            [ $exporting_package, @{$sources} ],
             $keywords
         );
     };
diff --git a/t/050_metaclasses/014_goto_moose_import.t b/t/050_metaclasses/014_goto_moose_import.t
index 77f45ff..41056a9 100644
--- a/t/050_metaclasses/014_goto_moose_import.t
+++ b/t/050_metaclasses/014_goto_moose_import.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 2;
+use Test::More tests => 8;
 use Test::Exception;
 
 # Some packages out in the wild cooperate with Moose by using goto
@@ -20,6 +20,10 @@ use Test::Exception;
     sub import {
         goto &Moose::import;
     }
+
+    sub unimport {
+        goto &Moose::unimport;
+    }
 }
 
 {
@@ -29,8 +33,17 @@ use Test::Exception;
 
     ::lives_ok( sub { has( 'size' ) },
                 'has was exported via MooseAlike1' );
+
+    MooseAlike1->unimport();
 }
 
+ok( ! Foo->can('has'),
+    'No has sub in Foo after MooseAlike1 is unimported' );
+ok( Foo->can('meta'),
+    'Foo has a meta method' );
+isa_ok( Foo->meta(), 'Moose::Meta::Class' );
+
+
 {
     package MooseAlike2;
 
@@ -43,6 +56,11 @@ use Test::Exception;
     sub import {
         goto $import;
     }
+
+    my $unimport = \&Moose::unimport;
+    sub unimport {
+        goto $unimport;
+    }
 }
 
 {
@@ -52,8 +70,13 @@ use Test::Exception;
 
     ::lives_ok( sub { has( 'size' ) },
                 'has was exported via MooseAlike2' );
-}
-
 
+    MooseAlike2->unimport();
+}
 
 
+ok( ! Bar->can('has'),
+          'No has sub in Bar after MooseAlike2 is unimported' );
+ok( Bar->can('meta'),
+    'Bar has a meta method' );
+isa_ok( Bar->meta(), 'Moose::Meta::Class' );