t/hints.t

   1 use strictures ();
   2 my $strictures_hints;
   3 BEGIN {
   4   local $ENV{PERL_STRICTURES_EXTRA} = 0;
   5   strictures->VERSION(1); strictures->import();
   6   # Find the hint value that 'use strictures 1' sets on this perl.
   7   $strictures_hints = $^H;
   8 }
   9 use strictures 1;
  10
  11 use Test::More;
  12 use Eval::WithLexicals;
  13
  14 my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new(prelude => '');
  15
  16 is_deeply(
  17   [ $eval->eval('$x = 1') ],
  18   [ 1 ],
  19   'Basic non-strict eval ok'
  20 );
  21
  22 is_deeply(
  23   $eval->lexicals, { },
  24   'Lexical not stored'
  25 );
  26
  27 $eval->eval('use strictures 1');
  28
  29 {
  30   local $SIG{__WARN__} = sub { };
  31
  32   ok !eval { $eval->eval('$x') }, 'Unable to use undeclared variable';
  33   like $@, qr/requires explicit package/, 'Correct message in $@';
  34 }
  35
  36 is_deeply(
  37   $eval->hints->{q{$^H}}, \$strictures_hints,
  38  'Hints are set per strictures'
  39 );
  40
  41 is_deeply(
  42   $eval->lexicals, { },
  43   'Lexical not stored'
  44 );
  45
  46 # Assumption about perl internals: sort pragma will set a key in %^H.
  47
  48 $eval->eval(q{ { use sort 'stable' } }),
  49 ok !exists $eval->hints->{q{%^H}}->{sort},
  50   "Lexical pragma used below main scope not captured";
  51
  52 $eval->eval(q{ use sort 'stable' }),
  53 ok exists $eval->hints->{q{%^H}}->{sort},
  54   "Lexical pragma captured";
  55
  56 done_testing;