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