diff --git a/Makefile.PL b/Makefile.PL index 5a3b535..0d33fef 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -53,6 +53,7 @@ my %WriteMakefileArgs = ( test => { requires => { 'Test::More' => '0.7', + 'Test::Deep' => '0', 'overload' => '0', }, }, diff --git a/lib/Test/Exception.pm b/lib/Test/Exception.pm index 93888ec..00ec98a 100644 --- a/lib/Test/Exception.pm +++ b/lib/Test/Exception.pm @@ -4,6 +4,7 @@ use warnings; package Test::Exception; use Test::Builder; use Sub::Uplevel qw( uplevel ); +use Scalar::Util; use base qw( Exporter ); our $VERSION = '0.43'; @@ -170,6 +171,7 @@ Tests to see that a specific exception is thrown. throws_ok() has two forms: throws_ok BLOCK REGEX, TEST_DESCRIPTION throws_ok BLOCK CLASS, TEST_DESCRIPTION + throws_ok BLOCK TEST_DEEP_EXPECTATION, TEST_DESCRIPTION In the first form the test passes if the stringified exception matches the give regular expression. For example: @@ -190,6 +192,21 @@ You can get the same effect by passing an instance of the exception you want to my $SIMPLE = Error::Simple->new; throws_ok { $foo->bar } $SIMPLE, 'simple error'; +The third form allows usage of L to write more complex tests. +L itself is not imported by L. + + throws_ok + { code that should throw exception } + all ( + obj_isa ('Expected::Exception::Instance'), + methods ( + errcode => 400, + errstr => re (qr/foo/), + ) + ), + 'description', + ; + Should a throws_ok() test fail it produces appropriate diagnostic messages. For example: not ok 3 - simple error @@ -213,6 +230,12 @@ form part of the string that throws_ok regular expressions match against. =cut +sub is_test_deep_cmp { + my ( $expecting ) = @_; + + return Scalar::Util::blessed( $expecting ) && $expecting->isa( 'Test::Deep::Cmp' ); +} + sub throws_ok (&$;$) { my ( $coderef, $expecting, $description ) = @_; unless (defined $expecting) { @@ -222,16 +245,28 @@ sub throws_ok (&$;$) { $description = _exception_as_string( "threw", $expecting ) unless defined $description; my $exception = _try_as_caller( $coderef ); - my $regex = $Tester->maybe_regex( $expecting ); - my $ok = $regex - ? ( $exception =~ m/$regex/ ) - : eval { - $exception->isa( ref $expecting ? ref $expecting : $expecting ) - }; + my ( $ok, $stack ); + my $is_test_deep_cmp = is_test_deep_cmp( $expecting ); + + if ( $is_test_deep_cmp ) { + ( $ok, $stack ) = Test::Deep::cmp_details( $exception, $expecting ); + } else { + my $regex = $Tester->maybe_regex( $expecting ); + $ok = $regex + ? ( $exception =~ m/$regex/ ) + : eval { + $exception->isa( ref $expecting ? ref $expecting : $expecting ) + }; + } + $Tester->ok( $ok, $description ); unless ( $ok ) { - $Tester->diag( _exception_as_string( "expecting:", $expecting ) ); - $Tester->diag( _exception_as_string( "found:", $exception ) ); + if ( $is_test_deep_cmp ) { + $Tester->diag( Test::Deep::deep_diag( $stack ) ); + } else { + $Tester->diag( _exception_as_string( "expecting:", $expecting ) ); + $Tester->diag( _exception_as_string( "found:", $exception ) ); + } }; $@ = $exception; return $ok; diff --git a/t/throws-ok-with-test-deep.t b/t/throws-ok-with-test-deep.t new file mode 100644 index 0000000..1767c3b --- /dev/null +++ b/t/throws-ok-with-test-deep.t @@ -0,0 +1,39 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More tests => 2; +use Test::Deep; + +BEGIN { use_ok( 'Test::Exception' ) }; + +throws_ok + { die Local::Error->new( code => 404, message => 'Not Found' ) } + all( + obj_isa( 'Local::Error' ), + methods( + code => 404, + message => re( qr/found/i ), + ), + ), + 'should recognize Test::Deep::Cmp expectation' + ; + +package + Local::Error; + +sub new { + my ( $class, %params ) = @_; + + bless \%params, $class; +} + +sub code { + $_[0]->{code}; +} + +sub message { + $_[0]->{message}; +} +