also preserve warnings
Graham Knop [Fri, 13 Jun 2014 11:53:46 +0000 (07:53 -0400)]
lib/Eval/WithLexicals/WithHintPersistence.pm
t/hints.t

index 0c09a23..d6a4ac0 100644 (file)
@@ -67,10 +67,18 @@ around capture_code => sub {
   my($self) = @_;
 
   ( q{ sub Eval::WithLexicals::Cage::capture_hints {
-          no warnings 'closure';
-          my($hints, %hints);
-          BEGIN { $hints = $^H; %hints = %^H; }
-          return q{$^H} => \$hints, q{%^H} => \%hints;
+          my ($hints, %hints, $warn_bits);
+          BEGIN {
+            no warnings 'closure';
+            $hints = $^H;
+            %hints = %^H;
+            $warn_bits = ${^WARNING_BITS};
+          }
+          return (
+            q{$^H}              => \$hints,
+            q{%^H}              => \%hints,
+            q{${^WARNING_BITS}} => \$warn_bits,
+          );
         } },
     $orig->(@_) )
 };
index 1e101b5..6a07969 100644 (file)
--- a/t/hints.t
+++ b/t/hints.t
@@ -1,17 +1,25 @@
 use strictures ();
-my $strictures_hints;
-BEGIN {
-  local $ENV{PERL_STRICTURES_EXTRA} = 0;
-  strictures->VERSION(1); strictures->import();
-  # Find the hint value that 'use strictures 1' sets on this perl.
-  $strictures_hints = $^H;
-}
-use strictures 1;
-
 use Test::More;
 use Eval::WithLexicals;
 use lib 't/lib';
 
+my $strictures_hints;
+my $strictures_warn;
+{
+  local $ENV{PERL_STRICTURES_EXTRA} = 0;
+  eval q{
+    use strictures 1;
+    BEGIN {
+      # Find the hint value that 'use strictures 1' sets on this perl.
+      $strictures_hints = $^H;
+      $strictures_warn = ${^WARNING_BITS};
+    };
+    1;
+  } or die $@;
+};
+
+use strictures 1;
+
 my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new(prelude => '');
 
 is_deeply(
@@ -34,11 +42,17 @@ $eval->eval('use strictures 1');
   like $@, qr/requires explicit package/, 'Correct message in $@';
 }
 
-is_deeply(
-  $eval->hints->{q{$^H}}, \$strictures_hints,
+is(
+  ${$eval->hints->{q{$^H}}}, $strictures_hints,
  'Hints are set per strictures'
 );
 
+is(
+  (unpack "H*", ${$eval->hints->{q{${^WARNING_BITS}}}}),
+  (unpack "H*", $strictures_warn),
+  'Warning bits are set per strictures'
+);
+
 is_deeply(
   $eval->lexicals, { },
   'Lexical not stored'