use warnings;
use Test::More;
+use Test::Exception;
+use Test::Warn;
use lib qw(t/lib);
use DBICTest;
-plan tests => 9;
-
# Set up the "usual" sqlite for DBICTest
my $schema = DBICTest->init_schema;
# which might need updating at some future time to be some other
# exception-generating statement:
-sub throwex { $schema->resultset("Artist")->search(1,1,1); }
+my $throw = sub { $schema->resultset("Artist")->search(1,1,1) };
my $ex_regex = qr/Odd number of arguments to search/;
# Basic check, normal exception
-eval { throwex };
-my $e = $@; # like() seems to stringify $@
-like($@, $ex_regex);
+throws_ok \&$throw, $ex_regex;
+
+my $e = $@;
# Re-throw the exception with rethrow()
-eval { $e->rethrow };
+throws_ok { $e->rethrow }
+ $ex_regex;
isa_ok( $@, 'DBIx::Class::Exception' );
-like($@, $ex_regex);
# Now lets rethrow via exception_action
-$schema->exception_action(sub { die @_ });
-eval { throwex };
-like($@, $ex_regex);
+{
+ my $handler_execution_counter = 0;
+
+ $schema->exception_action(sub {
+ $handler_execution_counter++;
+ like $_[0], $ex_regex, "Exception is precisely passed to exception_action";
+ die @_
+ });
+ throws_ok \&$throw, $ex_regex;
+ is $handler_execution_counter, 1, "exception_action handler executed exactly once";
+}
+
+#
+# This should have never worked!!!
+#
# Now lets suppress the error
$schema->exception_action(sub { 1 });
-eval { throwex };
-ok(!$@, "Suppress exception");
+throws_ok \&$throw,
+ qr/exception_action handler .+ did \*not\* result in an exception.+original error: $ex_regex/;
# Now lets fall through and let croak take back over
$schema->exception_action(sub { return });
-eval { throwex };
-like($@, $ex_regex);
+throws_ok {
+ warnings_are \&$throw,
+ qr/exception_action handler installed .+ returned false instead throwing an exception/;
+} $ex_regex;
+
+# again to see if no warning
+throws_ok {
+ warnings_are \&$throw,
+ [];
+} $ex_regex;
+
# Whacky useless exception class
{
# Try the exception class
$schema->exception_action(sub { DBICTest::Exception->throw(@_) });
-eval { throwex };
-like($@, qr/DBICTest::Exception is handling this: $ex_regex/);
+throws_ok \&$throw,
+ qr/DBICTest::Exception is handling this: $ex_regex/;
# While we're at it, lets throw a custom exception through Storage::DBI
-eval { $schema->storage->throw_exception('floob') };
-like($@, qr/DBICTest::Exception is handling this: floob/);
-
-
-# This usage is a bit unusual but it was actually seen in the wild
-eval {
-
- my $dbh = $schema->storage->dbh;
- undef $schema;
-
- $dbh->do ('glaring_syntax_error;');
-};
-like($@, qr/DBI Exception.+do failed/, 'Exception thrown even after $storage is destroyed');
+throws_ok { $schema->storage->throw_exception('floob') }
+ qr/DBICTest::Exception is handling this: floob/;
+
+# test antipatterns
+for my $ap (qw(
+ DBICTest::AntiPattern::TrueZeroLen
+ DBICTest::AntiPattern::NullObject
+)) {
+ eval "require $ap";
+ my $exp_warn = qr/\QObjects of external exception class '$ap' stringify to '' (the empty string)/;
+
+ # make sure an exception_action can replace $@ with an antipattern
+ $schema->exception_action(sub { die $ap->new });
+ warnings_like {
+ eval { $throw->() };
+ isa_ok $@, $ap;
+ } $exp_warn, 'proper warning on antipattern encountered within exception_action';
+
+ # and make sure that the retrhow works
+ $schema->exception_action(sub { die @_ });
+ warnings_like {
+ eval {
+ $schema->txn_do (sub { die $ap->new });
+ };
+
+ isa_ok $@, $ap;
+ } $exp_warn, 'Proper warning on encountered antipattern';
+}
+done_testing;