t/Root/Exception.t

   1 # -*-Perl-*- Test Harness script for Bioperl
   2
   3 use strict;
   4
   5 BEGIN {
   6     eval {require Error;};
   7
   8     use lib qw( . t/lib );
   9     use Bio::Root::Test;
  10
  11     test_begin(-tests => 7,
  12                -requires_module => 'Error');
  13
  14     use_ok('Bio::Root::TestObject');
  15 }
  16
  17 use Error qw(:try);
  18 $Error::Debug = test_debug();
  19
  20 # Set up a tester object.
  21 ok my $test = Bio::Root::TestObject->new(-verbose => test_debug());
  22
  23 is $test->data('Eeny meeny miney moe.'), 'Eeny meeny miney moe.';
  24
  25 # This demonstrates what will happen if a method defined in an
  26 # interface that is not implemented in the implementating object.
  27
  28 eval {
  29     try {
  30         $test->foo();
  31     }
  32     catch Bio::Root::NotImplemented with {
  33         my $err = shift;
  34         is ref $err, 'Bio::Root::NotImplemented';
  35     };
  36 };
  37
  38 # TestObject::bar() deliberately throws a Bio::TestException,
  39 # which is defined in TestObject.pm
  40 try {
  41     $test->bar;
  42 }
  43 catch Bio::TestException with {
  44     my $err = shift;
  45     is ref $err, 'Bio::TestException';
  46 };
  47
  48
  49 # Use the non-object-oriented syntax to throw a generic Bio::Root::Exception.
  50 try {
  51     throw Bio::Root::Exception( "A generic error", 42 );
  52 }
  53 catch Bio::Root::Exception with {
  54     my $err = shift;
  55     is ref $err, 'Bio::Root::Exception';
  56     is $err->value, 42;
  57 };
  58
  59 # Try to call a subroutine that doesn't exist. But because it occurs
  60 # within a try block, the Error module will create a Error::Simple to
  61 # capture it. Handy eh?
  62
  63 try {
  64     $test->foobar();
  65 }
  66 otherwise {
  67     my $err = shift;
  68     is ref $err, 'Error::Simple';
  69 };