Start known issues changelog section - place it on top for clarity

[dbsrgits/DBIx-Class.git] / t / 34exception_action.t

diff --git a/t/34exception_action.t b/t/34exception_action.t
index b81e568..aa803eb 100644 (file)
--- a/t/34exception_action.t
+++ b/t/34exception_action.t
@@ -1,10 +1,13 @@
+BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
+
 use strict;
 use warnings;
 
 use Test::More;
 use Test::Exception;
 use Test::Warn;
-use lib qw(t/lib);
+use Scalar::Util 'weaken';
+
 use DBICTest;
 
 # Set up the "usual" sqlite for DBICTest
@@ -90,4 +93,45 @@ throws_ok \&$throw,
 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;