xt/extra/internals/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 ### Test for strictures leakage
  10 my $q = do {
  11   no strict 'vars';
  12   quote_sub 'DBICTest::QSUB::nostrict'
  13     => '$x = $x . "buh"; $x += 42';
  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
  28 my $no_nothing_q = sub {
  29   no strict;
  30   no warnings;
  31   quote_sub 'DBICTest::QSUB::nowarn', <<'EOC';
  32     BEGIN { warn "-->${^WARNING_BITS}<--\n" };
  33     my $n = "Test::Warn::warnings_exist";
  34     warn "-->@{[ *{$n}{CODE} ]}<--\n";
  35 EOC
  36 };
  37
  38 my $we_cref = Test::Warn->can('warnings_exist');
  39
  40 warnings_exist { $no_nothing_q->()->() } [
  41   qr/^\-\-\>\0+\<\-\-$/m,
  42   qr/^\Q-->$we_cref<--\E$/m,
  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;