From: Graham Knop Date: Fri, 13 Jun 2014 11:53:46 +0000 (-0400) Subject: also preserve warnings X-Git-Tag: v1.003000~8 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=p5sagit%2FEval-WithLexicals.git;a=commitdiff_plain;h=14786ff863ce8fbc95583e3a39b9ca29c4f0958c also preserve warnings --- diff --git a/lib/Eval/WithLexicals/WithHintPersistence.pm b/lib/Eval/WithLexicals/WithHintPersistence.pm index 0c09a23..d6a4ac0 100644 --- a/lib/Eval/WithLexicals/WithHintPersistence.pm +++ b/lib/Eval/WithLexicals/WithHintPersistence.pm @@ -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->(@_) ) }; diff --git a/t/hints.t b/t/hints.t index 1e101b5..6a07969 100644 --- 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'