t/hints.t

   1 use strictures ();
   2 use Test::More;
   3 use Eval::WithLexicals;
   4 use lib 't/lib';
   5
   6 use strictures 1;
   7 use get_strictures_hints qw($strictures_hints $strictures_warn);
   8
   9 my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new(prelude => '');
  10
  11 is_deeply(
  12   [ $eval->eval('$x = 1') ],
  13   [ 1 ],
  14   'Basic non-strict eval ok'
  15 );
  16
  17 is_deeply(
  18   $eval->lexicals, { },
  19   'Lexical not stored'
  20 );
  21
  22 $eval->eval('use strictures 1');
  23
  24 {
  25   local $SIG{__WARN__} = sub { };
  26
  27   ok !eval { $eval->eval('${"x"}') }, 'Unable to use undeclared variable';
  28   like $@, qr/Can't use string .* as a SCALAR ref/,
  29   'Correct message in $@';
  30 }
  31
  32 is(
  33   ${$eval->hints->{q{$^H}}}, $strictures_hints,
  34  'Hints are set per strictures'
  35 );
  36
  37 is(
  38   (unpack "H*", ${$eval->hints->{q{${^WARNING_BITS}}}}),
  39   (unpack "H*", $strictures_warn),
  40   'Warning bits are set per strictures'
  41 );
  42
  43 is_deeply(
  44   $eval->lexicals, { },
  45   'Lexical not stored'
  46 );
  47
  48 # Assumption about perl internals: sort pragma will set a key in %^H.
  49 $eval->eval(q{ { use hint_hash_pragma 'param' } }),
  50 ok !exists $eval->hints->{q{%^H}}->{hint_hash_pragma},
  51   "Lexical pragma used below main scope not captured";
  52
  53 $eval->eval(q{ use hint_hash_pragma 'param' }),
  54 is $eval->hints->{q{%^H}}->{hint_hash_pragma}, 'param',
  55   "Lexical pragma captured";
  56
  57 done_testing;