3 use Eval::WithLexicals;
7 use get_strictures_hints;
9 my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new(prelude => '');
12 [ $eval->eval('$x = 1') ],
14 'Basic non-strict eval ok'
22 my ($strictures_hints, $strictures_warn) = get_strictures_hints::hints();
23 $eval->eval('use strictures 1');
26 local $SIG{__WARN__} = sub { };
28 ok !eval { $eval->eval('${"x"}') }, 'Unable to use undeclared variable';
29 like $@, qr/Can't use string .* as a SCALAR ref/,
30 'Correct message in $@';
34 ${$eval->hints->{q{$^H}}}, $strictures_hints,
35 'Hints are set per strictures'
39 (unpack "H*", ${ $eval->hints->{'${^WARNING_BITS}'} }),
40 (unpack "H*", $strictures_warn),
41 'Warning bits are set per strictures'
45 [ $_ => $warnings::Bits{$_} ],
46 [ "fatal $_" => $warnings::DeadBits{$_} ],
53 [ missing => $strictures_warn ],
54 [ extra => ${ $eval->hints->{'${^WARNING_BITS}'} } ],
56 my $bits = $check->[1];
57 $info{$check->[0]} = {
58 map { ($bits & $_->[1]) =~ /[^\0]/ ? ( $_->[0] => 1 ) : () }
64 my @extra = keys %{$info{extra}};
65 my @missing = keys %{$info{missing}};
66 delete @{$info{missing}}{ @extra };
67 delete @{$info{extra}}{ @missing };
70 for my $type (qw(missing extra)) {
71 my @found = grep $info{$type}{$_}, map $_->[0], @cats;
84 # Assumption about perl internals: sort pragma will set a key in %^H.
85 $eval->eval(q{ { use hint_hash_pragma 'param' } }),
86 ok !exists $eval->hints->{q{%^H}}->{hint_hash_pragma},
87 "Lexical pragma used below main scope not captured";
89 $eval->eval(q{ use hint_hash_pragma 'param' }),
90 is $eval->hints->{q{%^H}}->{hint_hash_pragma}, 'param',
91 "Lexical pragma captured";
93 $eval->eval('my $x = 1');
95 $eval->lexicals->{'$x'}, \1,
96 'Lexical captured when preserving hints',