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