X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F34exception_action.t;h=b35c7dc25cf0ed7a2780f4d74a8f4fb0b18c4ccf;hb=84e4e006;hp=b81e568b79e2782938a74cb94f58b1baa0b10f30;hpb=4f29a592f18106f2b06660a1cb82911b0ebc2011;p=dbsrgits%2FDBIx-Class.git

diff --git a/t/34exception_action.t b/t/34exception_action.t
index b81e568..b35c7dc 100644
--- a/t/34exception_action.t
+++ b/t/34exception_action.t
@@ -90,4 +90,30 @@ 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_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;