Fix erroneous use of multidimensional array emulation in 1fb834df
[dbsrgits/DBIx-Class.git] / t / 34exception_action.t
CommitLineData
c0329273 1BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
2
4ffbc1d6 3use strict;
f54428ab 4use warnings;
4ffbc1d6 5
6use Test::More;
c3e9f718 7use Test::Exception;
8use Test::Warn;
c0329273 9
4ffbc1d6 10use DBICTest;
11
4ffbc1d6 12# Set up the "usual" sqlite for DBICTest
13my $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 19my $throw = sub { $schema->resultset("Artist")->search(1,1,1) };
4ffbc1d6 20my $ex_regex = qr/Odd number of arguments to search/;
21
22# Basic check, normal exception
65d35121 23throws_ok \&$throw, $ex_regex;
c3e9f718 24
25my $e = $@;
b2f408f3 26
27# Re-throw the exception with rethrow()
c3e9f718 28throws_ok { $e->rethrow }
29 $ex_regex;
b2f408f3 30isa_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 51throws_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 56throws_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
62throws_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 88throws_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 92throws_ok { $schema->storage->throw_exception('floob') }
93 qr/DBICTest::Exception is handling this: floob/;
9bf06dc0 94
84e4e006 95# test antipatterns
96for 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 121done_testing;