#============================================================= -*-perl-*-
#
# t/exception.t
#
# Test the Badger::Exception module.
#
# Written by Andy Wardley <abw@wardley.org>
#
# This is free software; you can redistribute it and/or modify it
# under the same terms as Perl itself.
#
#========================================================================
use strict;
use warnings;
use lib qw( ./lib ../lib ../../lib );
use Badger::Test
tests => 40,
debug => 'Badger::Exception',
args => \@ARGV;
use Badger::Utils 'refaddr';
use Badger::Exception;
use constant
Exception => 'Badger::Exception';
my $format = \$Badger::Exception::FORMAT;
my $default = $Badger::Exception::TYPE;
#------------------------------------------------------------------------
# constructor without args for all defaults
#------------------------------------------------------------------------
my $ex1 = Exception->new();
ok( $ex1, 'created first exception' );
is( $ex1->type(), $default,
"default exception type is '$default'" );
is( $ex1->info(), 'no information', 'no info by default' );
is( $ex1->file(), 'unknown', 'unknown file' );
is( $ex1->line(), 'unknown', 'unknown line' );
#------------------------------------------------------------------------
# default type defined in subclass
#------------------------------------------------------------------------
package My::Exception;
use base 'Badger::Exception';
our $TYPE = 'wibble';
package main;
$ex1 = My::Exception->new();
is( $ex1->type(), 'wibble', 'wibble type' );
#------------------------------------------------------------------------
# passing contstructor arguments
#------------------------------------------------------------------------
$ex1 = Exception->new({
type => 'wibble',
info => 'failed to wibble',
});
is( $ex1->type(), 'wibble', 'wibble error type' );
is( $ex1->info(), 'failed to wibble', 'wibble error info' );
is( $ex1->file(), 'unknown', 'unknown wibble error file' );
is( $ex1->line(), 'unknown', 'unknown wibble error line' );
$ex1 = Exception->new({
type => 'wobble',
info => 'failed to wobble',
file => 'wobbly/file',
line => 42,
});
is( $ex1->type(), 'wobble', 'wobble error type' );
is( $ex1->info(), 'failed to wobble', 'wobble error info' );
is( $ex1->file(), 'wobbly/file', 'wobble error file' );
is( $ex1->line(), '42', 'wobble error line' );
#------------------------------------------------------------------------
# call type() and info() to set/get
#------------------------------------------------------------------------
my $ex2 = Exception->new();
is( $ex2->type('food'), 'food', "set type to 'food'" );
is( $ex2->info('cheese roll'), 'cheese roll', "set info to 'cheese roll'" );
is( $ex2->type(), 'food', "got type 'food'" );
is( $ex2->info(), 'cheese roll', "got info 'cheese roll'" );
$Badger::Exception::FORMAT = '<type>/<info>';
is( $ex2->text(), 'food/cheese roll',
"text is '" . $ex2->text() . "'");
is( $ex2->text('<info>/<type>'), 'cheese roll/food',
"text is 'cheese roll/food'");
#------------------------------------------------------------------------
# structured exception types
#------------------------------------------------------------------------
my $ex4 = Exception->new( type => 'ex4.foo.bar',
info => 'information about ex4' );
ok( $ex4, 'created exception' );
is( $ex4->type(), 'ex4.foo.bar', 'ex4.type' );
is( $ex4->info(), 'information about ex4', 'ex4.info' );
is( $ex4->match_type('foo', 'ex4', 'ex4.foo', 'ex4.foo.bar'),
'ex4.foo.bar', 'hander matched ex4.foo.bar' );
is( $ex4->match_type('bar', 'ex4', 'ex4.foo', 'ex4.bar.foo.bar'),
'ex4.foo', 'hander matched ex4.foo' );
is( $ex4->match_type('bar', 'ex4', 'ex4.bar', 'ex4.bar.foo.bar'),
'ex4', 'hander matched ex4' );
ok( ! defined $ex4->match_type('bar', 'baz', 'ex4.bar', 'ex4.bar.foo.bar'),
'no handler matched' );
is( $ex4->match_type(['bar', 'ex4', 'ex4.foo', 'ex4.bar.foo.bar']),
'ex4.foo', 'hander matched ex4.foo via list ref' );
is( $ex4->match_type('bar ex4 ex4.foo ex4.bar.foo.bar'),
'ex4.foo', 'hander matched ex4.foo via string' );
is( $ex4->match_type({ bar => 10, ex4 => 20 }),
20, 'hander matched ex4.foo via hash ref' );
#-----------------------------------------------------------------------
# test throw()
#-----------------------------------------------------------------------
$Badger::Exception::FORMAT = '<type> error: <info>';
sub bar {
shift->throw;
}
sub foo {
bar(@_);
}
my $throw = Exception->new(
type => 'food',
info => 'bread is not fresh',
trace => 1
);
eval { foo($throw) };
my $catch = $@;
is( refaddr $throw, refaddr $catch, 'caught that which was thrown' );
like( $catch, qr/called from/, 'stack trace in text' );
my $stack = $catch->stack;
ok( $stack, 'got stack' );
is( scalar(@$stack), 3, 'stack has three frames' );
like( $stack->[0]->[1], qr/exception\.t/, 'called from exception.t' );
is( $stack->[0]->[2], 148, 'called from line 139' );
is( $stack->[0]->[3], 'main::bar', 'called from bar' );
is( $stack->[1]->[2], 157, 'called from line 148' );
is( $stack->[1]->[3], 'main::foo', 'called from foo' );
is( $stack->[2]->[3], '(eval)', 'called from eval' );
__END__
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: