File Coverage

blib/lib/Test/Abortable.pm
Criterion Covered Total %
statement 48 55 87.2
branch 6 14 42.8
condition 3 6 50.0
subroutine 7 7 100.0
pod 2 2 100.0
total 66 84 78.5


line stmt bran cond sub pod time code
1 2     2   120390 use strict;
  2         20  
  2         49  
2 2     2   8 use warnings;
  2         4  
  2         96  
3             package Test::Abortable 0.003;
4             # ABSTRACT: subtests that you can die your way out of ... but survive
5              
6             #pod =head1 OVERVIEW
7             #pod
8             #pod Test::Abortable provides a simple system for catching some exceptions and
9             #pod turning them into test events. For example, consider the code below:
10             #pod
11             #pod use Test::More;
12             #pod use Test::Abortable;
13             #pod
14             #pod use My::API; # code under test
15             #pod
16             #pod my $API = My::API->client;
17             #pod
18             #pod subtest "collection distinction" => sub {
19             #pod my $result = $API->do_first_thing;
20             #pod
21             #pod is($result->documents->first->title, "The Best Thing");
22             #pod isnt($result->documents->last->title, "The Best Thing");
23             #pod };
24             #pod
25             #pod subtest "document transcendence" => sub { ... };
26             #pod subtest "semiotic multiplexing" => sub { ... };
27             #pod subtest "homoiousios type vectors" => sub { ... };
28             #pod
29             #pod done_testing;
30             #pod
31             #pod In this code, C<< $result->documents >> is a collection. It has a C
32             #pod method that will throw an exception if the collection is empty. If that
33             #pod happens in our code, our test program will die and most of the other subtests
34             #pod won't run. We'd rather that we only abort the I. We could do that
35             #pod in a bunch of ways, like adding:
36             #pod
37             #pod return fail("no documents in response") if $result->documents->is_empty;
38             #pod
39             #pod ...but this becomes less practical as the number of places that might throw
40             #pod these kinds of exceptions grows. To minimize code that boils down to "and then
41             #pod stop unless it makes sense to go on," Test::Abortable provides a means to
42             #pod communicate, via exceptions, that the running subtest should be aborted,
43             #pod possibly with some test output, and that the program should then continue.
44             #pod
45             #pod Test::Abortable exports a C> routine that behaves like L
46             #pod Test::More|Test::More/subtest> but will handle and recover from abortable
47             #pod exceptions (defined below). It also exports C>, which behaves
48             #pod like a block eval that only catches abortable exceptions.
49             #pod
50             #pod For an exception to be "abortable," in this sense, it must respond to a
51             #pod C method. This method must return an arrayref of
52             #pod arrayrefs that describe the Test2 events to emit when the exception is caught.
53             #pod For example, the exception thrown by our sample code above might have a
54             #pod C method that returns:
55             #pod
56             #pod [
57             #pod [ Ok => (pass => 0, name => "->first called on empty collection") ],
58             #pod ]
59             #pod
60             #pod It's permissible to have passing Ok events, or only Diag events, or multiple
61             #pod events, or none — although providing none might lead to some serious confusion.
62             #pod
63             #pod Right now, any exception that provides this method will be honored. In the
64             #pod future, a facility for only allowing abortable exceptions of a given class may
65             #pod be added.
66             #pod
67             #pod =cut
68              
69 2     2   8 use Test2::API 1.302075 (); # no_fork
  2         41  
  2         60  
70 2         14 use Sub::Exporter -setup => {
71             exports => [ qw(subtest testeval) ],
72             groups => { default => [ qw(subtest testeval) ] },
73 2     2   1025 };
  2         22680  
74              
75             #pod =func subtest
76             #pod
77             #pod subtest "do some stuff" => sub {
78             #pod do_things;
79             #pod do_stuff;
80             #pod do_actions;
81             #pod };
82             #pod
83             #pod This routine looks just like Test::More's C and acts just like it,
84             #pod too, with one difference: the code item passed in is executed in a block
85             #pod C and any exception thrown is checked for C. If
86             #pod there's no exception, it returns normally. If there's an abortable exception,
87             #pod the events are sent to the test hub and the subtest finishes normally. If
88             #pod there's a non-abortable exception, it is rethrown.
89             #pod
90             #pod =cut
91              
92             sub subtest {
93 3     3 1 2763 my ($name, $code) = @_;
94              
95 3         7 my $ctx = Test2::API::context();
96              
97             my $pass = Test2::API::run_subtest($name, sub {
98 3     3   1137 my $ok = eval { $code->(); 1 };
  3         9  
  0         0  
99              
100 3         1095 my $ctx = Test2::API::context();
101              
102 3 50       204 if (! $ok) {
103 3         5 my $error = $@;
104 3 100 66     9 if (ref $error and my $events = eval { $error->as_test_abort_events }) {
  2         7  
105 2         53 for (@$events) {
106 4         29 my $e = $ctx->send_event(@$_);
107 4         838 $e->set_meta(test_abort_object => $error)
108             }
109             } else {
110 1         4 $ctx->release;
111 1         20 die $error;
112             }
113             }
114              
115 2         31 $ctx->release;
116              
117 2         61 return;
118 3         222 }, { no_fork => 1 });
119              
120 3         2338 $ctx->release;
121              
122 3         59 return $pass;
123             }
124              
125             #pod =func testeval
126             #pod
127             #pod my $result = testeval {
128             #pod my $x = get_the_x;
129             #pod my $y = acquire_y;
130             #pod return $x * $y;
131             #pod };
132             #pod
133             #pod C behaves like C, but only catches abortable exceptions. If
134             #pod the code passed to C throws an abortable exception C will
135             #pod return false and put the exception into C<$@>. Other exceptions are
136             #pod propagated.
137             #pod
138             #pod =cut
139              
140             sub testeval (&) {
141 1     1 1 1021 my ($code) = @_;
142 1         3 my $ctx = Test2::API::context();
143 1         69 my @result;
144              
145 1         1 my $wa = wantarray;
146 1         2 my $ok = eval {
147 1 50       21 if (not defined $wa) { $code->() }
  1 0       4  
148 0         0 elsif (not $wa) { @result = scalar $code->() }
149 0         0 else { @result = $code->() }
150              
151 0         0 1;
152             };
153              
154 1 50       535 if (! $ok) {
155 1         2 my $error = $@;
156 1 50 33     4 if (ref $error and my $events = eval { $error->as_test_abort_events }) {
  1         3  
157 1         10 for (@$events) {
158 1         4 my $e = $ctx->send_event(@$_);
159 1         243 $e->set_meta(test_abort_object => $error)
160             }
161              
162 1         14 $ctx->release;
163 1         20 $@ = $error;
164 1         3 return;
165             } else {
166 0           die $error;
167             }
168             }
169              
170 0           $ctx->release;
171 0 0         return $wa ? @result : $result[0];
172             }
173              
174             #pod =head1 EXCEPTION IMPLEMENTATIONS
175             #pod
176             #pod You don't need to use an exception class provided by Test::Abortable to build
177             #pod abortable exceptions. This is by design. In fact, Test::Abortable doesn't
178             #pod ship with any abortable exception classes at all. You should just add a
179             #pod C where it's useful and appropriate.
180             #pod
181             #pod Here are two possible simple implementations of trivial abortable exception
182             #pod classes. First, using plain old vanilla objects:
183             #pod
184             #pod package Abort::Test {
185             #pod sub as_test_abort_events ($self) {
186             #pod return [ [ Ok => (pass => 0, name => $self->{message}) ] ];
187             #pod }
188             #pod }
189             #pod sub abort ($message) { die bless { message => $message }, 'Abort::Test' }
190             #pod
191             #pod This works, but if those exceptions ever get caught somewhere else, you'll be
192             #pod in a bunch of pain because they've got no stack trace, no stringification
193             #pod behavior, and so on. For a more robust but still tiny implementation, you
194             #pod might consider L:
195             #pod
196             #pod use failures 'testabort';
197             #pod sub failure::testabort::as_test_abort_events ($self) {
198             #pod return [ [ Ok => (pass => 0, name => $self->msg) ] ];
199             #pod }
200             #pod
201             #pod For whatever it's worth, the author's intent is to add C
202             #pod methods to his code through the use of application-specific Moose roles,
203             #pod
204             #pod =cut
205              
206             1;
207              
208             __END__