fix pragmas from "importing" leaking into outer scopes
Graham Knop [Fri, 27 Sep 2013 16:38:07 +0000 (12:38 -0400)]
Changes
lib/Package/Variant.pm
t/30-pragma-leak.t [new file with mode: 0644]

diff --git a/Changes b/Changes
index cc8457d..e25d5bf 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 Revision history for Package-Variant
 
+  - fix pragmas applied by modules listed in "importing" from leaking out
+    into unexpected scopes
+
 1.001004   2013-05-04
   - fix documentation of "build_variant_of" method (RT#84554 -- thanks,
     Scott Miller!)
index fca5a49..8ff3f56 100644 (file)
@@ -2,7 +2,7 @@ package Package::Variant;
 
 use strictures 1;
 use Import::Into;
-use Module::Runtime qw(use_module);
+use Module::Runtime qw(require_module);
 use Carp qw(croak);
 
 our $VERSION = '1.001004'; # 1.1.4
@@ -96,7 +96,9 @@ sub build_variant_of {
   my $variant_name = "${variable}::_Variant_".++$Variable{$variable}{anon};
   foreach my $to_import (@{$Variable{$variable}{args}{importing}}) {
     my ($pkg, $args) = @$to_import;
-    use_module($pkg)->import::into($variant_name, @{$args});
+    require_module $pkg;
+    eval q{ BEGIN { $pkg->import::into($variant_name, @{$args}) }; 1; }
+      or die $@;
   }
   my $subs = $Variable{$variable}{subs};
   local @{$subs}{keys %$subs} = map $variant_name->can($_), keys %$subs;
diff --git a/t/30-pragma-leak.t b/t/30-pragma-leak.t
new file mode 100644 (file)
index 0000000..6e5a6f7
--- /dev/null
@@ -0,0 +1,32 @@
+use strictures 1;
+use Test::More;
+use Test::Fatal;
+use Package::Variant ();
+
+BEGIN {
+  package TestPragma;
+  use Package::Variant
+    importing => [ 'strict' ];
+  sub make_variant { }
+  $INC{'TestPragma.pm'} = __FILE__;
+}
+
+is exception {
+  eval q{
+    no strict;
+    use TestPragma;
+    $var = $var;
+    1;
+  } or die $@;
+}, undef, 'pragmas not applied where PV package used';
+
+is exception {
+  eval q{
+    no strict;
+    BEGIN { my $p = TestPragma(); }
+    $var2 = $var2;
+    1;
+  } or die $@;
+}, undef, 'pragmas not applied where PV generator used';
+
+done_testing;