#line 1
package Test::Exception::LessClever;
use strict;
use warnings;
use base 'Exporter';
use Test::Builder;
use Carp qw/carp/;
#{{{ POD
#line 52
#}}}
our @EXPORT_OK = qw/live_or_die/;
our @EXPORT = qw/lives_ok dies_ok throws_ok lives_and/;
our @CARP_NOT = ( __PACKAGE__ );
our $TB = Test::Builder->new;
our $VERSION = "0.006";
#line 77
sub live_or_die {
my ( $code ) = @_;
my $return = eval { $code->(); 'did not die' } || "died";
my $msg = $@;
if ( $return eq 'did not die' ) {
return ( 1, $return ) if wantarray;
return 1;
}
else {
return 0 unless wantarray;
if ( !$msg ) {
carp "code died as expected, however the error is masked. This"
. " can occur when an object's DESTROY() method calls eval";
}
return ( 0, $msg );
}
}
#line 104
sub lives_ok(&;$) {
my ( $code, $name ) = @_;
my $ok = live_or_die( $code );
$TB->ok( $ok, $name );
return $ok;
}
#line 117
sub dies_ok(&;$) {
my ( $code, $name ) = @_;
my $ok = live_or_die( $code );
$TB->ok( !$ok, $name );
return !$ok;
}
#line 132
sub throws_ok(&$;$) {
my ( $code, $reg, $name ) = @_;
my ( $ok, $msg ) = live_or_die( $code );
my ( $pkg, $file, $number ) = caller;
# If we lived
if ( $ok ) {
$TB->diag( "Test did not die as expected at $file line $number." );
return $TB->ok( !$ok, $name );
}
my $match = $msg =~ $reg ? 1 : 0;
$TB->ok( $match, $name );
$TB->diag( "$file line $number:\n Wanted: $reg\n Got: $msg" )
unless( $match );
return $match;
}
#line 160
sub lives_and(&;$) {
my ( $code, $name ) = @_;
my ( $ok, $msg )= live_or_die( $code );
my ( $pkg, $file, $number ) = caller;
chomp( $msg );
$msg =~ s/\n/ /g;
$TB->diag( "Test unexpectedly died: '$msg' at $file line $number." ) unless $ok;
$TB->ok( $ok, $name ) if !$ok;
return $ok;
}
1;
__END__