From: Graham Knop <haarg@haarg.org>
Date: Fri, 27 Sep 2013 16:38:07 +0000 (-0400)
Subject: fix pragmas from "importing" leaking into outer scopes
X-Git-Tag: v1.002000~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3c1ca277175ea9b9bcce0f674d99b6da40eaa293;p=p5sagit%2FPackage-Variant.git

fix pragmas from "importing" leaking into outer scopes
---

diff --git a/Changes b/Changes
index cc8457d..e25d5bf 100644
--- 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!)
diff --git a/lib/Package/Variant.pm b/lib/Package/Variant.pm
index fca5a49..8ff3f56 100644
--- a/lib/Package/Variant.pm
+++ b/lib/Package/Variant.pm
@@ -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
index 0000000..6e5a6f7
--- /dev/null
+++ b/t/30-pragma-leak.t
@@ -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;