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; |