Commit | Line | Data |
7f9a3f70 |
1 | use warnings; |
2 | use strict; |
3 | |
4 | use Test::More; |
5 | use Test::Warn; |
6 | |
7 | use DBIx::Class::_Util 'quote_sub'; |
8 | |
9 | my $q = do { |
10 | no strict 'vars'; |
11 | quote_sub '$x = $x . "buh"; $x += 42'; |
12 | }; |
13 | |
14 | warnings_exist { |
15 | is $q->(), 42, 'Expected result after uninit and string/num conversion' |
16 | } [ |
17 | qr/Use of uninitialized value/i, |
18 | qr/isn't numeric in addition/, |
19 | ], 'Expected warnings, strict did not leak inside the qsub' |
20 | or do { |
21 | require B::Deparse; |
22 | diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($q) ) ) |
23 | } |
24 | ; |
25 | |
26 | my $no_nothing_q = do { |
27 | no strict; |
28 | no warnings; |
29 | quote_sub <<'EOC'; |
30 | my $n = "Test::Warn::warnings_exist"; |
31 | warn "-->@{[ *{$n}{CODE} ]}<--\n"; |
32 | warn "-->@{[ ${^WARNING_BITS} || '' ]}<--\n"; |
33 | EOC |
34 | }; |
35 | |
36 | my $we_cref = Test::Warn->can('warnings_exist'); |
37 | |
38 | warnings_exist { $no_nothing_q->() } [ |
39 | qr/^\Q-->$we_cref<--\E$/m, |
40 | qr/^\-\-\>\0*\<\-\-$/m, # some perls have a string of nulls, some just an empty string |
41 | ], 'Expected warnings, strict did not leak inside the qsub' |
42 | or do { |
43 | require B::Deparse; |
44 | diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($no_nothing_q) ) ) |
45 | } |
46 | ; |
47 | |
48 | done_testing; |