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