t/34exception_action.t

   1 BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) }
   2
   3 use strict;
   4 use warnings;
   5
   6 use Test::More;
   7 use Test::Exception;
   8 use Test::Warn;
   9
  10 use DBICTest;
  11
  12 # Set up the "usual" sqlite for DBICTest
  13 my $schema = DBICTest->init_schema;
  14
  15 # This is how we're generating exceptions in the rest of these tests,
  16 #  which might need updating at some future time to be some other
  17 #  exception-generating statement:
  18
  19 my $throw  = sub { $schema->resultset("Artist")->search(1,1,1) };
  20 my $ex_regex = qr/Odd number of arguments to search/;
  21
  22 # Basic check, normal exception
  23 throws_ok \&$throw, $ex_regex;
  24
  25 my $e = $@;
  26
  27 # Re-throw the exception with rethrow()
  28 throws_ok { $e->rethrow }
  29   $ex_regex;
  30 isa_ok( $@, 'DBIx::Class::Exception' );
  31
  32 # Now lets rethrow via exception_action
  33 {
  34   my $handler_execution_counter = 0;
  35
  36   $schema->exception_action(sub {
  37     $handler_execution_counter++;
  38     like $_[0], $ex_regex, "Exception is precisely passed to exception_action";
  39     die @_
  40   });
  41
  42   throws_ok \&$throw, $ex_regex;
  43   is $handler_execution_counter, 1, "exception_action handler executed exactly once";
  44 }
  45
  46 #
  47 # This should have never worked!!!
  48 #
  49 # Now lets suppress the error
  50 $schema->exception_action(sub { 1 });
  51 throws_ok \&$throw,
  52   qr/exception_action handler .+ did \*not\* result in an exception.+original error: $ex_regex/;
  53
  54 # Now lets fall through and let croak take back over
  55 $schema->exception_action(sub { return });
  56 throws_ok {
  57   warnings_are \&$throw,
  58     qr/exception_action handler installed .+ returned false instead throwing an exception/;
  59 } $ex_regex;
  60
  61 # again to see if no warning
  62 throws_ok {
  63   warnings_are \&$throw,
  64     [];
  65 } $ex_regex;
  66
  67
  68 # Whacky useless exception class
  69 {
  70     package DBICTest::Exception;
  71     use overload '""' => \&stringify, fallback => 1;
  72     sub new {
  73         my $class = shift;
  74         bless { msg => shift }, $class;
  75     }
  76     sub throw {
  77         my $self = shift;
  78         die $self if ref $self eq __PACKAGE__;
  79         die $self->new(shift);
  80     }
  81     sub stringify {
  82         "DBICTest::Exception is handling this: " . shift->{msg};
  83     }
  84 }
  85
  86 # Try the exception class
  87 $schema->exception_action(sub { DBICTest::Exception->throw(@_) });
  88 throws_ok \&$throw,
  89   qr/DBICTest::Exception is handling this: $ex_regex/;
  90
  91 # While we're at it, lets throw a custom exception through Storage::DBI
  92 throws_ok { $schema->storage->throw_exception('floob') }
  93   qr/DBICTest::Exception is handling this: floob/;
  94
  95 # test antipatterns
  96 for my $ap (qw(
  97   DBICTest::AntiPattern::TrueZeroLen
  98   DBICTest::AntiPattern::NullObject
  99 )) {
 100   eval "require $ap";
 101   my $exp_warn = qr/\QObjects of external exception class '$ap' stringify to '' (the empty string)/;
 102
 103   # make sure an exception_action can replace $@ with an antipattern
 104   $schema->exception_action(sub { die $ap->new });
 105   warnings_like {
 106     eval { $throw->() };
 107     isa_ok $@, $ap;
 108   } $exp_warn, 'proper warning on antipattern encountered within exception_action';
 109
 110   # and make sure that the rethrow works
 111   $schema->exception_action(sub { die @_ });
 112   warnings_like {
 113     eval {
 114       $schema->txn_do (sub { die $ap->new });
 115     };
 116
 117     isa_ok $@, $ap;
 118   } $exp_warn, 'Proper warning on encountered antipattern';
 119 }
 120
 121 done_testing;