#! /usr/bin/perl -w
package Test::Exception;
use 5.005;
use strict;
use Test::Builder;
use Sub::Uplevel;
use base qw(Exporter);
use vars qw($VERSION @EXPORT @EXPORT_OK);
$VERSION = '0.15';
@EXPORT = qw(dies_ok lives_ok throws_ok lives_and);
my $Tester = Test::Builder->new;
=head1 NAME
Test::Exception - test functions for exception based code
=head1 SYNOPSIS
use Test::More tests => 5;
use Test::Exception;
# Check that something died
dies_ok {$foo->method1} 'expecting to die';
# Check that something did not die
lives_ok {$foo->method2} 'expecting to live';
# Check that the stringified exception matches given regex
throws_ok {$foo->method3} qr/division by zero/, 'zero caught okay';
# Check an exception of the given class (or subclass) is thrown
throws_ok {$foo->method4} 'Error::Simple', 'simple error thrown';
# Check that a test runs without an exception
lives_and {is $foo->method, 42} 'method is 42';
=head1 DESCRIPTION
This module provides a few convenience methods for testing exception based code. It is built with L<Test::Builder> and plays happily with L<Test::More> and friends.
If you are not already familiar with L<Test::More> now would be the time to go take a look.
=cut
sub _try_as_caller {
my $sub = shift;
eval { uplevel 3, $sub };
return $@;
};
sub _is_exception {
my $exception = shift;
ref($exception) || $exception ne '';
};
sub _exception_as_string {
my ($prefix, $exception) = @_;
return "$prefix undef" unless defined($exception);
return "$prefix normal exit" unless _is_exception($exception);
my $class = ref($exception);
$exception = "$class ($exception)"
if $class && "$exception" !~ m/^\Q$class/;
chomp($exception);
return("$prefix $exception");
};
=over 4
=item B<dies_ok>
Checks that a piece of code dies, rather than returning normally. For example:
sub div {
my ($a, $b) = @_;
return( $a / $b );
};
dies_ok { div(1, 0) } 'divide by zero detected';
A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).
The test name is optional, but recommended.
=cut
sub dies_ok (&;$) {
my ($sub, $name) = @_;
my $exception = _try_as_caller($sub);
my $ok = $Tester->ok( _is_exception($exception), $name );
$@ = $exception;
return($ok);
}
=item B<lives_ok>
Checks that a piece of code exits normally, and doesn't die. For example:
sub read_file {
my $file = shift;
local $/ = undef;
open(FILE, $file) or die "open failed ($!)\n";
$file = <FILE>;
close(FILE);
return($file);
};
my $file;
lives_ok { $file = read_file('test.txt') } 'file read';
Should a lives_ok() test fail it produces appropriate diagnostic messages. For example:
not ok 1 - file read
# Failed test (test.t at line 15)
# died: open failed (No such file or directory)
A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).
The test name is optional, but recommended.
=cut
sub lives_ok (&;$) {
my ($sub, $name) = @_;
my $exception = _try_as_caller($sub);
my $died = _is_exception($exception);
my $ok = $Tester->ok(!$died, $name);
$Tester->diag(_exception_as_string("died:", $exception)) if $died;
$@ = $exception;
return($ok);
}
=item B<throws_ok>
Tests to see that a specific exception is thrown. throws_ok() has two forms:
throws_ok BLOCK REGEX, TEST_NAME
throws_ok BLOCK CLASS, TEST_NAME
In the first form the test passes if the stringified exception matches the give regular expression. For example:
throws_ok {
read_file('test.txt')
} qr/No such file/, 'no file';
If your perl does not support C<qr//> you can also pass a regex-like string, for example:
throws_ok {
read_file('/etc/kcpassword')
} '/Permission denied/', 'no permissions';
The second form of throws_ok() test passes if the exception is of the same class as the one supplied, or a subclass of that class. For example:
throws_ok {$foo->bar} "Error::Simple", 'simple error';
Will only pass if the C<bar> method throws an Error::Simple exception, or a subclass of an Error::Simple exception.
You can get the same effect by passing an instance of the exception you want to look for. The following is equivalent to the previous example:
my $SIMPLE = Error::Simple->new();
throws_ok {$foo->bar} $SIMPLE, 'simple error';
Should a throws_ok() test fail it produces appropriate diagnostic messages. For example:
not ok 3 - simple error
# Failed test (test.t at line 48)
# expecting: Error::Simple exception
# found: normal exit
A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).
The test name is optional. If no test name is given a description of the exception being checked for is used.
=cut
sub throws_ok (&$;$) {
my ($sub, $class, $test_name) = @_;
$test_name ||= _exception_as_string("threw", $class);
my $exception = _try_as_caller($sub);
my $regex = $Tester->maybe_regex($class);
my $ok = $regex ? ($exception =~ m/$regex/)
: UNIVERSAL::isa($exception, ref($class) || $class);
$Tester->ok($ok, $test_name);
unless ($ok) {
$Tester->diag( _exception_as_string("expecting:", $class) );
$Tester->diag( _exception_as_string("found:", $exception) );
};
$@ = $exception;
return($ok);
};
=item B<lives_and>
Run a test that may throw an exception. For example, instead of doing:
my $file;
lives_ok { $file = read_file('answer.txt') } 'read_file worked';
is $file, "42\n", 'answer was 42';
You can use lives_and() like this:
lives_and { is read_file('answer.txt'), "42\n" } 'answer is 42';
Which is the same as doing
is read_file('answer.txt'), "42\n", 'answer is 42';
unless C<read_file('answer.txt')> dies, in which case you get the same kind of error as lives_ok()
not ok 1 - answer is 42
# Failed test (test.t at line 15)
# died: open failed (No such file or directory)
A true value is returned if the test succeeds, false otherwise. On exit $@ is guaranteed to be the cause of death (if any).
The test name is optional, but recommended.
=cut
sub lives_and (&$) {
my ($test, $name) = @_;
local $Test::Builder::Level = $Test::Builder::Level+1;
{
my $ok = \&Test::Builder::ok;
no warnings;
local *Test::Builder::ok = sub {
$_[2] = $name unless defined $_[2];
$ok->(@_);
};
use warnings;
eval { $test->() } and return 1;
};
my $exception = $@;
if (_is_exception($exception)) {
$Tester->ok(0, $name);
$Tester->diag( _exception_as_string("died:", $exception) );
};
$@ = $exception;
return;
}
=back
=head1 BUGS
None known at the time of writing.
If you find any please let me know by e-mail, or report the problem with L<http://rt.cpan.org/>.
=head1 TO DO
Nothing at the time of writing.
If you think this module should do something that it doesn't do at the moment please let me know.
=head1 ACKNOWLEGEMENTS
Thanks to chromatic and Michael G Schwern for the excellent Test::Builder, without which this module wouldn't be possible.
Thanks to Michael G Schwern and Mark Fowler for suggestions and comments on initial versions of this module.
Thanks to Janek Schleicher, Michael G Schwern, chromatic and Mark Fowler for reporting/fixing bugs.
Thanks to Aristotle for suggesting lives_and.
=head1 AUTHOR
Adrian Howard <adrianh@quietstars.com>
If you can spare the time, please drop me a line if you find this module useful.
=head1 SEE ALSO
L<Test::Builder> provides a consistent backend for building test libraries. The following modules are all built with L<Test::Builder> and work well together.
=over 4
=item L<Test::Simple> & L<Test::More>
Basic utilities for writing tests.
=item L<Test::Class>
Easily create test classes in an xUnit style.
=item L<Test::Differences>
Test strings and data structures and show differences if not ok.
=item L<Test::Inline>
Inlining your tests next to the code being tested.
=back
=head1 LICENCE
Copyright 2002 Adrian Howard, All Rights Reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
=cut
1;