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 | |
e85eb407 |
9 | ### Test for strictures leakage |
7f9a3f70 |
10 | my $q = do { |
11 | no strict 'vars'; |
e85eb407 |
12 | quote_sub 'DBICTest::QSUB::nostrict' |
13 | => '$x = $x . "buh"; $x += 42'; |
7f9a3f70 |
14 | }; |
15 | |
16 | warnings_exist { |
17 | is $q->(), 42, 'Expected result after uninit and string/num conversion' |
18 | } [ |
19 | qr/Use of uninitialized value/i, |
20 | qr/isn't numeric in addition/, |
21 | ], 'Expected warnings, strict did not leak inside the qsub' |
22 | or do { |
23 | require B::Deparse; |
24 | diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($q) ) ) |
25 | } |
26 | ; |
27 | |
e85eb407 |
28 | my $no_nothing_q = sub { |
7f9a3f70 |
29 | no strict; |
30 | no warnings; |
e85eb407 |
31 | quote_sub 'DBICTest::QSUB::nowarn', <<'EOC'; |
c480ff4a |
32 | BEGIN { warn "-->${^WARNING_BITS}<--\n" }; |
7f9a3f70 |
33 | my $n = "Test::Warn::warnings_exist"; |
34 | warn "-->@{[ *{$n}{CODE} ]}<--\n"; |
7f9a3f70 |
35 | EOC |
36 | }; |
37 | |
38 | my $we_cref = Test::Warn->can('warnings_exist'); |
39 | |
e85eb407 |
40 | warnings_exist { $no_nothing_q->()->() } [ |
c480ff4a |
41 | qr/^\-\-\>\0+\<\-\-$/m, |
7f9a3f70 |
42 | qr/^\Q-->$we_cref<--\E$/m, |
7f9a3f70 |
43 | ], 'Expected warnings, strict did not leak inside the qsub' |
44 | or do { |
45 | require B::Deparse; |
46 | diag( B::Deparse->new->coderef2text( Sub::Quote::unquote_sub($no_nothing_q) ) ) |
47 | } |
48 | ; |
49 | |
50 | done_testing; |