account for coderefs partially
[dbsrgits/DBIx-Class.git] / t / 34exception_action.t
CommitLineData
4ffbc1d6 1use strict;
f54428ab 2use warnings;
4ffbc1d6 3
4use Test::More;
c3e9f718 5use Test::Exception;
6use Test::Warn;
4ffbc1d6 7use lib qw(t/lib);
8use DBICTest;
9
4ffbc1d6 10# Set up the "usual" sqlite for DBICTest
11my $schema = DBICTest->init_schema;
12
13# This is how we're generating exceptions in the rest of these tests,
14# which might need updating at some future time to be some other
15# exception-generating statement:
16
65d35121 17my $throw = sub { $schema->resultset("Artist")->search(1,1,1) };
4ffbc1d6 18my $ex_regex = qr/Odd number of arguments to search/;
19
20# Basic check, normal exception
65d35121 21throws_ok \&$throw, $ex_regex;
c3e9f718 22
23my $e = $@;
b2f408f3 24
25# Re-throw the exception with rethrow()
c3e9f718 26throws_ok { $e->rethrow }
27 $ex_regex;
b2f408f3 28isa_ok( $@, 'DBIx::Class::Exception' );
4ffbc1d6 29
30# Now lets rethrow via exception_action
31$schema->exception_action(sub { die @_ });
65d35121 32throws_ok \&$throw, $ex_regex;
4ffbc1d6 33
c3e9f718 34#
35# This should have never worked!!!
36#
4ffbc1d6 37# Now lets suppress the error
38$schema->exception_action(sub { 1 });
65d35121 39throws_ok \&$throw,
c3e9f718 40 qr/exception_action handler .+ did \*not\* result in an exception.+original error: $ex_regex/;
4ffbc1d6 41
42# Now lets fall through and let croak take back over
43$schema->exception_action(sub { return });
c3e9f718 44throws_ok {
65d35121 45 warnings_are \&$throw,
c3e9f718 46 qr/exception_action handler installed .+ returned false instead throwing an exception/;
47} $ex_regex;
48
49# again to see if no warning
50throws_ok {
65d35121 51 warnings_are \&$throw,
c3e9f718 52 [];
53} $ex_regex;
54
4ffbc1d6 55
56# Whacky useless exception class
57{
58 package DBICTest::Exception;
59 use overload '""' => \&stringify, fallback => 1;
60 sub new {
61 my $class = shift;
62 bless { msg => shift }, $class;
63 }
64 sub throw {
65 my $self = shift;
66 die $self if ref $self eq __PACKAGE__;
67 die $self->new(shift);
68 }
69 sub stringify {
70 "DBICTest::Exception is handling this: " . shift->{msg};
71 }
72}
73
74# Try the exception class
75$schema->exception_action(sub { DBICTest::Exception->throw(@_) });
65d35121 76throws_ok \&$throw,
c3e9f718 77 qr/DBICTest::Exception is handling this: $ex_regex/;
4ffbc1d6 78
79# While we're at it, lets throw a custom exception through Storage::DBI
c3e9f718 80throws_ok { $schema->storage->throw_exception('floob') }
81 qr/DBICTest::Exception is handling this: floob/;
9bf06dc0 82
68fe9141 83done_testing;