Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
4ffbc1d6 |
3 | use strict; |
f54428ab |
4 | use warnings; |
4ffbc1d6 |
5 | |
6 | use Test::More; |
c3e9f718 |
7 | use Test::Exception; |
8 | use Test::Warn; |
c0329273 |
9 | |
4ffbc1d6 |
10 | use DBICTest; |
11 | |
4ffbc1d6 |
12 | # Set up the "usual" sqlite for DBICTest |
13 | my $schema = DBICTest->init_schema; |
14 | |
15 | # This is how we're generating exceptions in the rest of these tests, |
16 | # which might need updating at some future time to be some other |
17 | # exception-generating statement: |
18 | |
65d35121 |
19 | my $throw = sub { $schema->resultset("Artist")->search(1,1,1) }; |
4ffbc1d6 |
20 | my $ex_regex = qr/Odd number of arguments to search/; |
21 | |
22 | # Basic check, normal exception |
65d35121 |
23 | throws_ok \&$throw, $ex_regex; |
c3e9f718 |
24 | |
25 | my $e = $@; |
b2f408f3 |
26 | |
27 | # Re-throw the exception with rethrow() |
c3e9f718 |
28 | throws_ok { $e->rethrow } |
29 | $ex_regex; |
b2f408f3 |
30 | isa_ok( $@, 'DBIx::Class::Exception' ); |
4ffbc1d6 |
31 | |
32 | # Now lets rethrow via exception_action |
4f29a592 |
33 | { |
34 | my $handler_execution_counter = 0; |
35 | |
36 | $schema->exception_action(sub { |
37 | $handler_execution_counter++; |
38 | like $_[0], $ex_regex, "Exception is precisely passed to exception_action"; |
39 | die @_ |
40 | }); |
41 | |
42 | throws_ok \&$throw, $ex_regex; |
43 | is $handler_execution_counter, 1, "exception_action handler executed exactly once"; |
44 | } |
4ffbc1d6 |
45 | |
c3e9f718 |
46 | # |
47 | # This should have never worked!!! |
48 | # |
4ffbc1d6 |
49 | # Now lets suppress the error |
50 | $schema->exception_action(sub { 1 }); |
65d35121 |
51 | throws_ok \&$throw, |
c3e9f718 |
52 | qr/exception_action handler .+ did \*not\* result in an exception.+original error: $ex_regex/; |
4ffbc1d6 |
53 | |
54 | # Now lets fall through and let croak take back over |
55 | $schema->exception_action(sub { return }); |
c3e9f718 |
56 | throws_ok { |
65d35121 |
57 | warnings_are \&$throw, |
c3e9f718 |
58 | qr/exception_action handler installed .+ returned false instead throwing an exception/; |
59 | } $ex_regex; |
60 | |
61 | # again to see if no warning |
62 | throws_ok { |
65d35121 |
63 | warnings_are \&$throw, |
c3e9f718 |
64 | []; |
65 | } $ex_regex; |
66 | |
4ffbc1d6 |
67 | |
68 | # Whacky useless exception class |
69 | { |
70 | package DBICTest::Exception; |
71 | use overload '""' => \&stringify, fallback => 1; |
72 | sub new { |
73 | my $class = shift; |
74 | bless { msg => shift }, $class; |
75 | } |
76 | sub throw { |
77 | my $self = shift; |
78 | die $self if ref $self eq __PACKAGE__; |
79 | die $self->new(shift); |
80 | } |
81 | sub stringify { |
82 | "DBICTest::Exception is handling this: " . shift->{msg}; |
83 | } |
84 | } |
85 | |
86 | # Try the exception class |
87 | $schema->exception_action(sub { DBICTest::Exception->throw(@_) }); |
65d35121 |
88 | throws_ok \&$throw, |
c3e9f718 |
89 | qr/DBICTest::Exception is handling this: $ex_regex/; |
4ffbc1d6 |
90 | |
91 | # While we're at it, lets throw a custom exception through Storage::DBI |
c3e9f718 |
92 | throws_ok { $schema->storage->throw_exception('floob') } |
93 | qr/DBICTest::Exception is handling this: floob/; |
9bf06dc0 |
94 | |
84e4e006 |
95 | # test antipatterns |
96 | for my $ap (qw( |
97 | DBICTest::AntiPattern::TrueZeroLen |
98 | DBICTest::AntiPattern::NullObject |
99 | )) { |
100 | eval "require $ap"; |
101 | my $exp_warn = qr/\QObjects of external exception class '$ap' stringify to '' (the empty string)/; |
102 | |
103 | # make sure an exception_action can replace $@ with an antipattern |
104 | $schema->exception_action(sub { die $ap->new }); |
105 | warnings_like { |
106 | eval { $throw->() }; |
107 | isa_ok $@, $ap; |
108 | } $exp_warn, 'proper warning on antipattern encountered within exception_action'; |
109 | |
ddcc02d1 |
110 | # and make sure that the rethrow works |
84e4e006 |
111 | $schema->exception_action(sub { die @_ }); |
112 | warnings_like { |
113 | eval { |
114 | $schema->txn_do (sub { die $ap->new }); |
115 | }; |
116 | |
117 | isa_ok $@, $ap; |
118 | } $exp_warn, 'Proper warning on encountered antipattern'; |
119 | } |
120 | |
68fe9141 |
121 | done_testing; |