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 6package IO::Async::Test; 7 8use strict; 9use warnings; 10 11our $VERSION = '0.800'; 12 13use Exporter 'import'; 14our @EXPORT = qw( 15 testing_loop 16 wait_for 17 wait_for_stream 18 wait_for_future 19); 20 21=head1 NAME 22 23C<IO::Async::Test> - 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 61This module provides utility functions that may be useful when writing test 62scripts for code which uses L<IO::Async> (as well as being used in the 63L<IO::Async> test scripts themselves). 64 65Test scripts are often synchronous by nature; they are a linear sequence of 66actions to perform, interspersed with assertions which check for given 67conditions. This goes against the very nature of L<IO::Async> which, being an 68asynchronisation framework, does not provide a linear stepped way of working. 69 70In order to write a test, the C<wait_for> function provides a way of 71synchronising the code, so that a given condition is known to hold, which 72would typically signify that some event has occurred, the outcome of which can 73now be tested using the usual testing primitives. 74 75Because the primary purpose of L<IO::Async> is to provide IO operations on 76filehandles, a great many tests will likely be based around connected pipes or 77socket handles. The C<wait_for_stream> function provides a convenient way 78to wait for some content to be written through such a connected stream. 79 80=cut 81 82my $loop; 83END { undef $loop } 84 85=head1 FUNCTIONS 86 87=cut 88 89=head2 testing_loop 90 91 testing_loop( $loop ) 92 93Set the L<IO::Async::Loop> object which the C<wait_for> function will loop 94on. 95 96=cut 97 98sub testing_loop 99{ 100 $loop = shift; 101} 102 103=head2 wait_for 104 105 wait_for { COND } OPTS 106 107Repeatedly call the C<loop_once> method on the underlying loop (given to the 108C<testing_loop> function), until the given condition function callback 109returns true. 110 111To guard against stalled scripts, if the loop indicates a timeout for (a 112default of) 10 consequentive seconds, then an error is thrown. 113 114Takes the following named options: 115 116=over 4 117 118=item timeout => NUM 119 120The time in seconds to wait before giving up the test as being stalled. 121Defaults to 10 seconds. 122 123=back 124 125=cut 126 127sub wait_for(&@) 128{ 129 my ( $cond, %opts ) = @_; 130 131 my ( undef, $callerfile, $callerline ) = caller; 132 133 my $timedout = 0; 134 my $timerid = $loop->watch_time( 135 after => $opts{timeout} // 10, 136 code => sub { $timedout = 1 }, 137 ); 138 139 $loop->loop_once( 1 ) while !$cond->() and !$timedout; 140 141 if( $timedout ) { 142 die "Nothing was ready after 10 second wait; called at $callerfile line $callerline\n"; 143 } 144 else { 145 $loop->unwatch_time( $timerid ); 146 } 147} 148 149=head2 wait_for_stream 150 151 wait_for_stream { COND } $handle, $buffer 152 153As C<wait_for>, but will also watch the given IO handle for readability, and 154whenever it is readable will read bytes in from it into the given buffer. The 155buffer is NOT initialised when the function is entered, in case data remains 156from a previous call. 157 158C<$buffer> can also be a CODE reference, in which case it will be invoked 159being passed data read from the handle, whenever it is readable. 160 161=cut 162 163sub wait_for_stream(&$$) 164{ 165 my ( $cond, $handle, undef ) = @_; 166 167 my $on_read; 168 if( ref $_[2] eq "CODE" ) { 169 $on_read = $_[2]; 170 } 171 else { 172 my $varref = \$_[2]; 173 $on_read = sub { $$varref .= $_[0] }; 174 } 175 176 $loop->watch_io( 177 handle => $handle, 178 on_read_ready => sub { 179 my $ret = $handle->sysread( my $buffer, 8192 ); 180 if( !defined $ret ) { 181 die "Read failed on $handle - $!\n"; 182 } 183 elsif( $ret == 0 ) { 184 die "Read returned EOF on $handle\n"; 185 } 186 $on_read->( $buffer ); 187 } 188 ); 189 190 # Have to defeat the prototype... grr I hate these 191 &wait_for( $cond ); 192 193 $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 203I<Since version 0.68.> 204 205A handy wrapper around using C<wait_for> to wait for a L<Future> to become 206ready. The future instance itself is returned, allowing neater code. 207 208=cut 209 210sub wait_for_future 211{ 212 my ( $future ) = @_; 213 214 wait_for { $future->is_ready }; 215 216 return $future; 217} 218 219=head1 AUTHOR 220 221Paul Evans <leonerd@leonerd.org.uk> 222 223=cut 224 2250x55AA; 226