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;