Switch travis-perl tests to 5.18
[dbsrgits/DBIx-Class.git] / t / 106dbic_carp.t
CommitLineData
8fda97d5 1use strict;
2use warnings;
3
5e0e5426 4# without this the stacktrace of $schema will be activated
5BEGIN { $ENV{DBIC_TRACE} = 0 }
6
8fda97d5 7use Test::More;
8use Test::Warn;
5e0e5426 9use Test::Exception;
8fda97d5 10use DBIx::Class::Carp;
11use lib 't/lib';
12use DBICTest;
13
5e0e5426 14{
15 sub DBICTest::DBICCarp::frobnicate {
16 DBICTest::DBICCarp::branch1();
17 DBICTest::DBICCarp::branch2();
18 }
8fda97d5 19
5e0e5426 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;
8fda97d5 36
5e0e5426 37 sub _skip_namespace_frames { qr/^DBICTest::DBICCarp::Exempt/ }
38
39 sub thrower {
40 sub {
cc414f09 41 DBICTest->init_schema(no_deploy => 1)->storage->dbh_do(sub {
42 shift->throw_exception('time to die');
43 })
5e0e5426 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 ;
8fda97d5 78}
79
5e0e5426 80done_testing;