Commit | Line | Data |
2b376bd0 |
1 | use strictures (); |
8d732f30 |
2 | use Test::More; |
3 | use Eval::WithLexicals; |
9661a07c |
4 | use lib 't/lib'; |
8d732f30 |
5 | |
14786ff8 |
6 | my $strictures_hints; |
7 | my $strictures_warn; |
8 | { |
9 | local $ENV{PERL_STRICTURES_EXTRA} = 0; |
10 | eval q{ |
11 | use strictures 1; |
12 | BEGIN { |
13 | # Find the hint value that 'use strictures 1' sets on this perl. |
14 | $strictures_hints = $^H; |
15 | $strictures_warn = ${^WARNING_BITS}; |
16 | }; |
17 | 1; |
18 | } or die $@; |
19 | }; |
20 | |
21 | use strictures 1; |
22 | |
8d732f30 |
23 | my $eval = Eval::WithLexicals->with_plugins("HintPersistence")->new(prelude => ''); |
24 | |
25 | is_deeply( |
26 | [ $eval->eval('$x = 1') ], |
27 | [ 1 ], |
28 | 'Basic non-strict eval ok' |
29 | ); |
30 | |
31 | is_deeply( |
32 | $eval->lexicals, { }, |
33 | 'Lexical not stored' |
34 | ); |
35 | |
36 | $eval->eval('use strictures 1'); |
37 | |
38 | { |
39 | local $SIG{__WARN__} = sub { }; |
40 | |
41 | ok !eval { $eval->eval('$x') }, 'Unable to use undeclared variable'; |
42 | like $@, qr/requires explicit package/, 'Correct message in $@'; |
43 | } |
44 | |
14786ff8 |
45 | is( |
46 | ${$eval->hints->{q{$^H}}}, $strictures_hints, |
8d732f30 |
47 | 'Hints are set per strictures' |
48 | ); |
49 | |
14786ff8 |
50 | is( |
51 | (unpack "H*", ${$eval->hints->{q{${^WARNING_BITS}}}}), |
52 | (unpack "H*", $strictures_warn), |
53 | 'Warning bits are set per strictures' |
54 | ); |
55 | |
8d732f30 |
56 | is_deeply( |
57 | $eval->lexicals, { }, |
58 | 'Lexical not stored' |
59 | ); |
60 | |
61 | # Assumption about perl internals: sort pragma will set a key in %^H. |
9661a07c |
62 | $eval->eval(q{ { use hint_hash_pragma 'param' } }), |
63 | ok !exists $eval->hints->{q{%^H}}->{hint_hash_pragma}, |
8d732f30 |
64 | "Lexical pragma used below main scope not captured"; |
65 | |
9661a07c |
66 | $eval->eval(q{ use hint_hash_pragma 'param' }), |
67 | is $eval->hints->{q{%^H}}->{hint_hash_pragma}, 'param', |
8d732f30 |
68 | "Lexical pragma captured"; |
69 | |
70 | done_testing; |