diff --git a/README.pod b/README.pod index ccf1744..2574234 100644 --- a/README.pod +++ b/README.pod @@ -40,6 +40,8 @@ This is Perl module B. It's Object-Oriented testing library. # matches '(?^:b)' # matched at line: 1, offset: 2 + $arr->throw(sub { die 'Baz' })->catch(qr/^Ba/); + =head1 INSTALLATION diff --git a/lib/Test/Arrow.pm b/lib/Test/Arrow.pm index 05bc954..7b65ca3 100644 --- a/lib/Test/Arrow.pm +++ b/lib/Test/Arrow.pm @@ -334,6 +334,54 @@ sub _get_isa_diag_name { return($diag, $name); } +sub throw_ok { + my $self = shift; + + eval { shift->() }; + + $KLASS->builder->ok(!!$@, $self->_specific('_name', $_[0])); +} + +sub throw { + my $self = shift; + my $code = shift; + + die 'The `throw` method expects code ref.' unless ref $code eq 'CODE'; + + eval { $code->() }; + + if (my $e = $@) { + if (defined $_[0]) { + $KLASS->builder->like($e, $_[0], $_[1] || 'Thrown correctly'); + $self->_reset; + } + else { + $self->got($e); + } + } + else { + local $Test::Builder::Level = 2; + $self->fail('Not thrown'); + } + + $self; +} + +sub catch { + my $self = shift; + my $regex = shift; + + $KLASS->builder->like( + $self->_specific('_got', undef), + $regex, + $_[0] || 'Thrown correctly', + ); + + $self->_reset; + + $self; +} + 1; __END__ @@ -376,6 +424,8 @@ Test::Arrow - Object-Oriented testing library # matches '(?^:b)' # matched at line: 1, offset: 2 + $arr->throw(sub { die 'Baz' })->catch(qr/^Ba/); + =head1 DESCRIPTION @@ -505,6 +555,31 @@ It works on references, too: $arr->got($array_ref)->expected('ARRAY')->isa_ok; +=head2 EXCEPTION TEST + +=head3 throw_ok($code_ref) + +It makes sure that $code_ref gets an exception. + + $arr->throw_ok(sub { die 'oops' }); + +=head3 throw($code_ref) + +=head3 catch($regex) + +The C method invokes $code_ref, and if it's certenly thrown an exception, then an exception message will be set as $got and the $regex in C method will be evaluated to $got. + + $arr->throw(sub { die 'Baz' })->catch(qr/^Ba/); + +Above test is equivalent to below + + $arr->throw(sub { die 'Baz' })->expected(qr/^Ba/)->like; + +Actually, you can execute a test even only C method + + $arr->throw(sub { die 'Baz' }, qr/^Ba/); + + =head2 UTILITIES You can call below utilities methods even without an instance. diff --git a/t/06_throw.t b/t/06_throw.t new file mode 100644 index 0000000..c6ef91f --- /dev/null +++ b/t/06_throw.t @@ -0,0 +1,18 @@ +use strict; +use warnings; + +use Test::Arrow; + +my $arr = Test::Arrow->new; + +$arr->throw_ok(sub { die 'foo' }); +$arr->throw_ok(sub { die 'bar' }, 'die bar'); +$arr->name('die baz')->throw_ok(sub { die 'baz' }); +$arr->throw(sub { die 'bar' })->catch(qr/^ba/); +$arr->name('die bar')->throw(sub { die 'bar' })->catch(qr/^ba/); +$arr->throw(sub { die 'baz' })->catch(qr/^ba/, 'die baz'); +$arr->throw(sub { die 'bar' })->expect(qr/^ba/)->like; +$arr->throw(sub { die 'bar' }, qr/^ba/); +$arr->throw(sub { die 'bar' }, qr/^ba/, 'die bar'); + +$arr->done_testing;