X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F34exception_action.t;h=aa803eb238bada7b3e1e2693e38f39c096bc427a;hb=HEAD;hp=7fef551f0e9bc5bd6db8722ee72144805c5ffbca;hpb=c216324aa4b0f79ba056fbe74adbd735421e378a;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/34exception_action.t b/t/34exception_action.t
index 7fef551..aa803eb 100644
--- a/t/34exception_action.t
+++ b/t/34exception_action.t
@@ -1,11 +1,14 @@
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
 use strict;
-use warnings;  
+use warnings;
 
 use Test::More;
-use lib qw(t/lib);
-use DBICTest;
+use Test::Exception;
+use Test::Warn;
+use Scalar::Util 'weaken';
 
-plan tests => 6;
+use DBICTest;
 
 # Set up the "usual" sqlite for DBICTest
 my $schema = DBICTest->init_schema;
@@ -14,27 +17,54 @@ 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 };
-like($@, $ex_regex);
+throws_ok \&$throw, $ex_regex;
+
+my $e = $@;
+
+# Re-throw the exception with rethrow()
+throws_ok { $e->rethrow }
+  $ex_regex;
+isa_ok( $@, 'DBIx::Class::Exception' );
 
 # 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
 {
@@ -56,9 +86,52 @@ like($@, $ex_regex);
 
 # 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/);
+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_exist {
+    eval { $throw->() };
+    isa_ok $@, $ap;
+  } $exp_warn, 'proper warning on antipattern encountered within exception_action';
+
+  # and make sure that the rethrow works
+  $schema->exception_action(sub { die @_ });
+  warnings_exist {
+    eval {
+      $schema->txn_do (sub { die $ap->new });
+    };
+
+    isa_ok $@, $ap;
+  } $exp_warn, 'Proper warning on encountered antipattern';
+}
+
+# ensure we do not get into an infloop
+{
+  weaken( my $s = $schema );
+
+  $schema->exception_action(sub{
+    $s->throw_exception(@_)
+  });
+
+  throws_ok {
+    $schema->storage->dbh_do(sub {
+      $_[1]->do('wgwfwfwghawhjsejsethjwetjesjesjsejsetjes')
+    } )
+  } qr/syntax error/i;
+}
+
+done_testing;