account for coderefs partially
[dbsrgits/DBIx-Class.git] / 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 lib 't/lib';
11 use DBICTest;
12 use DBIx::Class::Carp;
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)->storage->dbh_do(sub {
42           shift->throw_exception('time to die');
43         })
44       }->();
45     }
46
47     sub dcaller {
48       sub {
49         thrower();
50       }->();
51     }
52
53     sub warner {
54       eval {
55         sub {
56           eval {
57             carp ('time to warn')
58           }
59         }->()
60       }
61     }
62
63     sub wcaller {
64       warner();
65     }
66   }
67
68   # the __LINE__ relationship below is important - do not reformat
69   throws_ok { DBICTest::DBICCarp::Exempt::dcaller() }
70     qr/\QDBICTest::DBICCarp::Exempt::thrower(): time to die at @{[ __FILE__ ]} line @{[ __LINE__ - 1 ]}\E$/,
71     'Expected exception callsite and originator'
72   ;
73
74   # the __LINE__ relationship below is important - do not reformat
75   warnings_like { DBICTest::DBICCarp::Exempt::wcaller() }
76     qr/\QDBICTest::DBICCarp::Exempt::warner(): time to warn at @{[ __FILE__ ]} line @{[ __LINE__ - 1 ]}\E$/,
77   ;
78 }
79
80 done_testing;