t/106dbic_carp.t

   1 use strict;
   2 use warnings;
   3
   4 # without this the stacktrace of $schema will be activated
   5 BEGIN { $ENV{DBIC_TRACE} = 0 }
   6
   7 use Test::More;
   8 use Test::Warn;
   9 use Test::Exception;
  10 use DBIx::Class::Carp;
  11 use lib 't/lib';
  12 use DBICTest;
  13
  14 {
  15   sub DBICTest::DBICCarp::frobnicate {
  16     DBICTest::DBICCarp::branch1();
  17     DBICTest::DBICCarp::branch2();
  18   }
  19
  20   sub DBICTest::DBICCarp::branch1 { carp_once 'carp1' }
  21   sub DBICTest::DBICCarp::branch2 { carp_once 'carp2' }
  22
  23
  24   warnings_exist {
  25     DBICTest::DBICCarp::frobnicate();
  26   } [
  27     qr/carp1/,
  28     qr/carp2/,
  29   ], 'expected warnings from carp_once';
  30 }
  31
  32 {
  33   {
  34     package DBICTest::DBICCarp::Exempt;
  35     use DBIx::Class::Carp;
  36
  37     sub _skip_namespace_frames { qr/^DBICTest::DBICCarp::Exempt/ }
  38
  39     sub thrower {
  40       sub {
  41         DBICTest->init_schema(no_deploy => 1)->throw_exception('time to die');
  42       }->();
  43     }
  44
  45     sub dcaller {
  46       sub {
  47         thrower();
  48       }->();
  49     }
  50
  51     sub warner {
  52       eval {
  53         sub {
  54           eval {
  55             carp ('time to warn')
  56           }
  57         }->()
  58       }
  59     }
  60
  61     sub wcaller {
  62       warner();
  63     }
  64   }
  65
  66   # the __LINE__ relationship below is important - do not reformat
  67   throws_ok { DBICTest::DBICCarp::Exempt::dcaller() }
  68     qr/\QDBICTest::DBICCarp::Exempt::thrower(): time to die at @{[ __FILE__ ]} line @{[ __LINE__ - 1 ]}\E$/,
  69     'Expected exception callsite and originator'
  70   ;
  71
  72   # the __LINE__ relationship below is important - do not reformat
  73   warnings_like { DBICTest::DBICCarp::Exempt::wcaller() }
  74     qr/\QDBICTest::DBICCarp::Exempt::warner(): time to warn at @{[ __FILE__ ]} line @{[ __LINE__ - 1 ]}\E$/,
  75   ;
  76 }
  77
  78 done_testing;