File Coverage

blib/lib/IO/Async/Test.pm
Criterion Covered Total %
statement 35 39 89.7
branch 5 8 62.5
condition 3 5 60.0
subroutine 11 12 91.6
pod 4 4 100.0
total 58 68 85.2


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2007-2015 -- leonerd@leonerd.org.uk
5              
6             package IO::Async::Test;
7              
8 96     96   134319 use strict;
  96         600  
  96         2887  
9 96     96   503 use warnings;
  96         201  
  96         3956  
10              
11             our $VERSION = '0.801';
12              
13 96     96   545 use Exporter 'import';
  96         183  
  96         56750  
14             our @EXPORT = qw(
15             testing_loop
16             wait_for
17             wait_for_stream
18             wait_for_future
19             );
20              
21             =head1 NAME
22              
23             C - utility functions for use in test scripts
24              
25             =head1 SYNOPSIS
26              
27             use Test::More tests => 1;
28             use IO::Async::Test;
29              
30             use IO::Async::Loop;
31             my $loop = IO::Async::Loop->new;
32             testing_loop( $loop );
33              
34             my $result;
35              
36             $loop->do_something(
37             some => args,
38              
39             on_done => sub {
40             $result = the_outcome;
41             }
42             );
43              
44             wait_for { defined $result };
45              
46             is( $result, what_we_expected, 'The event happened' );
47              
48             ...
49              
50             my $buffer = "";
51             my $handle = IO::Handle-> ...
52              
53             wait_for_stream { length $buffer >= 10 } $handle => $buffer;
54              
55             is( substr( $buffer, 0, 10, "" ), "0123456789", 'Buffer was correct' );
56              
57             my $result = wait_for_future( $stream->read_until( "\n" ) )->get;
58              
59             =head1 DESCRIPTION
60              
61             This module provides utility functions that may be useful when writing test
62             scripts for code which uses L (as well as being used in the
63             L test scripts themselves).
64              
65             Test scripts are often synchronous by nature; they are a linear sequence of
66             actions to perform, interspersed with assertions which check for given
67             conditions. This goes against the very nature of L which, being an
68             asynchronisation framework, does not provide a linear stepped way of working.
69              
70             In order to write a test, the C function provides a way of
71             synchronising the code, so that a given condition is known to hold, which
72             would typically signify that some event has occurred, the outcome of which can
73             now be tested using the usual testing primitives.
74              
75             Because the primary purpose of L is to provide IO operations on
76             filehandles, a great many tests will likely be based around connected pipes or
77             socket handles. The C function provides a convenient way
78             to wait for some content to be written through such a connected stream.
79              
80             =cut
81              
82             my $loop;
83 68     68   26546 END { undef $loop }
84              
85             =head1 FUNCTIONS
86              
87             =cut
88              
89             =head2 testing_loop
90              
91             testing_loop( $loop )
92              
93             Set the L object which the C function will loop
94             on.
95              
96             =cut
97              
98             sub testing_loop
99             {
100 126     126 1 1529 $loop = shift;
101             }
102              
103             =head2 wait_for
104              
105             wait_for { COND } OPTS
106              
107             Repeatedly call the C method on the underlying loop (given to the
108             C function), until the given condition function callback
109             returns true.
110              
111             To guard against stalled scripts, if the loop indicates a timeout for (a
112             default of) 10 consequentive seconds, then an error is thrown.
113              
114             Takes the following named options:
115              
116             =over 4
117              
118             =item timeout => NUM
119              
120             The time in seconds to wait before giving up the test as being stalled.
121             Defaults to 10 seconds.
122              
123             =back
124              
125             =cut
126              
127             sub wait_for(&@)
128             {
129 490     490 1 63640 my ( $cond, %opts ) = @_;
130              
131 490         4242 my ( undef, $callerfile, $callerline ) = caller;
132              
133 490         1449 my $timedout = 0;
134             my $timerid = $loop->watch_time(
135             after => $opts{timeout} // 10,
136 0     0   0 code => sub { $timedout = 1 },
137 490   50     12285 );
138              
139 490   66     1642 $loop->loop_once( 1 ) while !$cond->() and !$timedout;
140              
141 488 50       2834 if( $timedout ) {
142 0         0 die "Nothing was ready after 10 second wait; called at $callerfile line $callerline\n";
143             }
144             else {
145 488         2262 $loop->unwatch_time( $timerid );
146             }
147             }
148              
149             =head2 wait_for_stream
150              
151             wait_for_stream { COND } $handle, $buffer
152              
153             As C, but will also watch the given IO handle for readability, and
154             whenever it is readable will read bytes in from it into the given buffer. The
155             buffer is NOT initialised when the function is entered, in case data remains
156             from a previous call.
157              
158             C<$buffer> can also be a CODE reference, in which case it will be invoked
159             being passed data read from the handle, whenever it is readable.
160              
161             =cut
162              
163             sub wait_for_stream(&$$)
164             {
165 7     7 1 936 my ( $cond, $handle, undef ) = @_;
166              
167 7         18 my $on_read;
168 7 100       57 if( ref $_[2] eq "CODE" ) {
169 1         3 $on_read = $_[2];
170             }
171             else {
172 6         26 my $varref = \$_[2];
173 6     6   52 $on_read = sub { $$varref .= $_[0] };
  6         23  
174             }
175              
176             $loop->watch_io(
177             handle => $handle,
178             on_read_ready => sub {
179 7     7   37 my $ret = $handle->sysread( my $buffer, 8192 );
180 7 50       237 if( !defined $ret ) {
    50          
181 0         0 die "Read failed on $handle - $!\n";
182             }
183             elsif( $ret == 0 ) {
184 0         0 die "Read returned EOF on $handle\n";
185             }
186 7         23 $on_read->( $buffer );
187             }
188 7         82 );
189              
190             # Have to defeat the prototype... grr I hate these
191 7         33 &wait_for( $cond );
192              
193 7         345 $loop->unwatch_io(
194             handle => $handle,
195             on_read_ready => 1,
196             );
197             }
198              
199             =head2 wait_for_future
200              
201             $future = wait_for_future $future
202              
203             I
204              
205             A handy wrapper around using C to wait for a L to become
206             ready. The future instance itself is returned, allowing neater code.
207              
208             =cut
209              
210             sub wait_for_future
211             {
212 49     49 1 1411 my ( $future ) = @_;
213              
214 49     135   871 wait_for { $future->is_ready };
  135         877  
215              
216 49         2050 return $future;
217             }
218              
219             =head1 AUTHOR
220              
221             Paul Evans
222              
223             =cut
224              
225             0x55AA;