Entirely and utterly rewrite populate(), fixing the variable hash issue
[dbsrgits/DBIx-Class.git] / xt / quote_sub.t
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;