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, 2020-2022 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Test::Future::IO; |
7
|
|
|
|
|
|
|
|
8
|
4
|
|
|
4
|
|
167987
|
use strict; |
|
4
|
|
|
|
|
23
|
|
|
4
|
|
|
|
|
92
|
|
9
|
4
|
|
|
4
|
|
16
|
use warnings; |
|
4
|
|
|
|
|
5
|
|
|
4
|
|
|
|
|
121
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
12
|
|
|
|
|
|
|
|
13
|
4
|
|
|
4
|
|
15
|
use Carp; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
181
|
|
14
|
|
|
|
|
|
|
|
15
|
4
|
|
|
4
|
|
1457
|
use Test::ExpectAndCheck::Future 0.05; # ->whenever |
|
4
|
|
|
|
|
87159
|
|
|
4
|
|
|
|
|
89
|
|
16
|
4
|
|
|
4
|
|
25
|
use Test::Deep (); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
1751
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
C - unit testing on C |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
use Test::More; |
25
|
|
|
|
|
|
|
use Test::Future::IO; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $controller = Test::Future::IO->controller; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
$controller->expect_syswrite_anyfh( "Hello, world\n" ); |
31
|
|
|
|
|
|
|
$controller->expect_sysread_anyfh( 256 ) |
32
|
|
|
|
|
|
|
->will_done( "A string\n" ); |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
code_under_test(); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
$controller->check_and_clear( 'code under test did correct IO' ); |
37
|
|
|
|
|
|
|
} |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 DESCRIPTION |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
This package provides a means to apply unit testing around code which uses |
42
|
|
|
|
|
|
|
L. It operates in an "expect-and-check" style of mocking, |
43
|
|
|
|
|
|
|
requiring the test script to declare upfront what methods are expected to be |
44
|
|
|
|
|
|
|
called, and what values they return. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=cut |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=head1 EXPECTATIONS |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
Each of the actual C methods has a corresponding expectation |
51
|
|
|
|
|
|
|
method on the controller object, whose name is prefixed with C. A |
52
|
|
|
|
|
|
|
single call to one of these methods by the unit test script represents a |
53
|
|
|
|
|
|
|
single call to a C method that the code under test is expected to |
54
|
|
|
|
|
|
|
make. The arguments to the expectation method should match those given by the |
55
|
|
|
|
|
|
|
code under test. Each expectation method returns an object which has |
56
|
|
|
|
|
|
|
additional methods to control the behaviour of that invocation. |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
$exp = $controller->expect_sleep( $secs ); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
$exp = $controller->expect_sysread( $fh, $len ); |
61
|
|
|
|
|
|
|
$exp = $controller->expect_syswrite( $fh, $bytes ); |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
For testing simpler code that does not operate on multiple filehandles, two |
64
|
|
|
|
|
|
|
additional methods that ignore the filehandle argument may be more convenient: |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
$exp = $controller->expect_sysread_anyfh( $len ); |
67
|
|
|
|
|
|
|
$exp = $controller->expect_syswrite_anyfh( $bytes ); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
In each case the returned expectation object allows the test script to specify |
70
|
|
|
|
|
|
|
what such an invocation should return. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
$exp->will_done( @result ); |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
Expectations can make methods fail instead. |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
$exp->will_fail( $message ); |
77
|
|
|
|
|
|
|
$exp->will_fail( $message, $category, @details ); |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Expectations can be set to remain pending rather than completing. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
$exp->remains_pending; |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
As a convenience, a C expectation will default to returning a future |
84
|
|
|
|
|
|
|
that will complete yielding its length (as is usual for successful writes), |
85
|
|
|
|
|
|
|
and a C expectation will return a future that completes yielding |
86
|
|
|
|
|
|
|
nothing. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
Testing event-based code with C can be fragile, as it relies |
89
|
|
|
|
|
|
|
on exact ordering, buffer sizes, and so on. A more flexible approach that |
90
|
|
|
|
|
|
|
leads to less brittle tests is to use a buffer around that filehandle that is |
91
|
|
|
|
|
|
|
provided by the test module. The test module then intercepts all C |
92
|
|
|
|
|
|
|
method calls on the given filehandle to return data from that buffer: |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
$controller->use_sysread_buffer( $fh ); |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
$controller->write_sysread_buffer( $fh, $data ); |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
As a convenience for filling the sysread buffer at the right time, any |
99
|
|
|
|
|
|
|
expectation returned by this module supports two extra methods for invoking |
100
|
|
|
|
|
|
|
C when another expectation completes: |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
$exp->will_write_sysread_buffer( $fh, $data ); |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
$exp->will_write_sysread_buffer_later( $fh, $data ); |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
These are both shortcuts for calling L from within a |
107
|
|
|
|
|
|
|
C or C code block. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=cut |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
my ( $controller, $obj ) = Test::Future::IO::_Controller->create; |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
my %sysread_buffers; |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
require Future::IO; |
116
|
|
|
|
|
|
|
Future::IO->override_impl( $obj ); |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub expect_sleep |
119
|
|
|
|
|
|
|
{ |
120
|
4
|
|
|
4
|
0
|
9420
|
my $self = shift; |
121
|
4
|
|
|
|
|
8
|
my ( $secs ) = @_; |
122
|
|
|
|
|
|
|
|
123
|
4
|
|
|
|
|
15
|
return $controller->expect( sleep => $secs ) |
124
|
|
|
|
|
|
|
->will_done(); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
sub expect_sysread |
128
|
|
|
|
|
|
|
{ |
129
|
1
|
|
|
1
|
0
|
1554
|
my $self = shift; |
130
|
1
|
|
|
|
|
4
|
my ( $fh, $len ) = @_; |
131
|
1
|
50
|
|
|
|
16
|
if( @_ == 1 ) { |
132
|
0
|
|
|
|
|
0
|
carp "->expect_sysread with one argument is now deprecated"; |
133
|
0
|
|
|
|
|
0
|
( $fh, $len ) = ( Test::Deep::ignore(), @_ ); |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
1
|
|
|
|
|
15
|
return $controller->expect( sysread => $fh, $len ); |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
sub expect_syswrite |
140
|
|
|
|
|
|
|
{ |
141
|
1
|
|
|
1
|
0
|
1237
|
my $self = shift; |
142
|
1
|
|
|
|
|
3
|
my ( $fh, $bytes ) = @_; |
143
|
1
|
50
|
|
|
|
7
|
if( @_ == 1 ) { |
144
|
0
|
|
|
|
|
0
|
carp "->expect_syswrite with one argument is now deprecated"; |
145
|
0
|
|
|
|
|
0
|
( $fh, $bytes ) = ( Test::Deep::ignore(), @_ ); |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
1
|
|
|
|
|
7
|
return $controller->expect( syswrite => $fh, $bytes ) |
149
|
|
|
|
|
|
|
->will_done( length $bytes ); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
sub expect_sysread_anyfh |
153
|
|
|
|
|
|
|
{ |
154
|
1
|
|
|
1
|
0
|
1310
|
my $self = shift; |
155
|
1
|
|
|
|
|
7
|
$self->expect_sysread( Test::Deep::ignore() => @_ ); |
156
|
|
|
|
|
|
|
} |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
sub expect_syswrite_anyfh |
159
|
|
|
|
|
|
|
{ |
160
|
1
|
|
|
1
|
0
|
1123
|
my $self = shift; |
161
|
1
|
|
|
|
|
3
|
$self->expect_syswrite( Test::Deep::ignore() => @_ ); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 METHODS |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
=head2 controller |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
$controller = Test::Future::IO->controller; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
Returns the control object, on which the various C methods and |
173
|
|
|
|
|
|
|
C can be invoked. |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
3
|
|
|
3
|
1
|
194
|
sub controller { __PACKAGE__ } |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head2 check_and_clear |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$controller->check_and_clear( $name ); |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
Checks that by now, every expected method has been called, and emits a new |
184
|
|
|
|
|
|
|
test output line via L. Regardless, the expectations are also |
185
|
|
|
|
|
|
|
cleared out ready for the start of the next test. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub check_and_clear |
190
|
|
|
|
|
|
|
{ |
191
|
8
|
|
|
8
|
1
|
26766
|
shift; |
192
|
8
|
|
|
|
|
24
|
my ( $name ) = @_; |
193
|
|
|
|
|
|
|
|
194
|
8
|
|
|
|
|
14
|
local $Test::Builder::Level = $Test::Builder::Level + 1; |
195
|
8
|
|
|
|
|
46
|
$controller->check_and_clear( $name ); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
=head2 use_sysread_buffer |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
$controller->use_sysread_buffer( $fh ); |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
I |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
This method enables a read buffer for a given filehandle, that provides an |
205
|
|
|
|
|
|
|
alternative means of testing reading on a filehandle than using |
206
|
|
|
|
|
|
|
C. Once enabled, C<< Future::IO->sysread >> calls on the given |
207
|
|
|
|
|
|
|
filehandle handled internally by the test controller. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
The sysread buffer is initially empty, and can be written to by |
210
|
|
|
|
|
|
|
L. |
211
|
|
|
|
|
|
|
|
212
|
|
|
|
|
|
|
This is provided using a C C<< ->whenever >> |
213
|
|
|
|
|
|
|
expectation, which is returned by this method. This is useful in case you want |
214
|
|
|
|
|
|
|
to call the C<< ->indefinitely >> method on it, meaning it will survive past |
215
|
|
|
|
|
|
|
calls to L. |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
$controller->use_sysread_buffer( "FH" ) |
218
|
|
|
|
|
|
|
->indefinitely; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
=cut |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
sub use_sysread_buffer |
223
|
|
|
|
|
|
|
{ |
224
|
2
|
|
|
2
|
1
|
7893
|
my $self = shift; |
225
|
2
|
|
|
|
|
7
|
my ( $fh ) = @_; |
226
|
|
|
|
|
|
|
|
227
|
2
|
|
|
|
|
577
|
require Future::Buffer; |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# Not //= so that each test gets a new buffer |
230
|
2
|
|
|
|
|
1522
|
my $buffer = $sysread_buffers{$fh} = Future::Buffer->new; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
return $controller->whenever( sysread => $fh, Test::Deep::ignore() ) |
233
|
|
|
|
|
|
|
->will_return_using( sub { |
234
|
2
|
|
|
2
|
|
1962
|
my ( $args ) = @_; |
235
|
2
|
|
|
|
|
10
|
return $buffer->read_atmost( $args->[1] ); |
236
|
2
|
|
|
|
|
40
|
}); |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
=head2 write_sysread_buffer |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
$controller->write_sysread_buffer( $fh, $data ); |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
I |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
Appends more data to the sysread buffer previously established by the |
246
|
|
|
|
|
|
|
L. |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
Typically this is performed either initially as part of test setup, or later |
249
|
|
|
|
|
|
|
as a side-effect of other expectations completing. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
For example: |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
$controller->use_sysread_buffer( "FH" ); |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
$controller->expect_syswrite( "FH", "Question?\n" ) |
256
|
|
|
|
|
|
|
->will_write_sysread_buffer_later( "FH", "Answer!\n" ); |
257
|
|
|
|
|
|
|
|
258
|
|
|
|
|
|
|
=cut |
259
|
|
|
|
|
|
|
|
260
|
|
|
|
|
|
|
sub write_sysread_buffer |
261
|
|
|
|
|
|
|
{ |
262
|
2
|
|
|
2
|
1
|
106
|
my $self = shift; |
263
|
2
|
|
|
|
|
7
|
my ( $fh, $data ) = @_; |
264
|
|
|
|
|
|
|
|
265
|
2
|
50
|
|
|
|
11
|
my $buffer = $sysread_buffers{$fh} or |
266
|
|
|
|
|
|
|
croak "Filehandle $fh is not managed by a Test::Future::IO buffer"; |
267
|
|
|
|
|
|
|
|
268
|
2
|
|
|
|
|
8
|
$buffer->write( $data ); |
269
|
|
|
|
|
|
|
} |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
{ |
272
|
|
|
|
|
|
|
package Test::Future::IO::_Controller; |
273
|
4
|
|
|
4
|
|
25
|
use base qw( Test::ExpectAndCheck::Future ); |
|
4
|
|
|
|
|
7
|
|
|
4
|
|
|
|
|
395
|
|
274
|
4
|
|
|
4
|
|
24
|
use constant EXPECTATION_CLASS => "Test::Future::IO::_Expectation"; |
|
4
|
|
|
|
|
6
|
|
|
4
|
|
|
|
|
224
|
|
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
{ |
278
|
|
|
|
|
|
|
package Test::Future::IO::_Expectation; |
279
|
4
|
|
|
4
|
|
21
|
use base qw( Test::ExpectAndCheck::Future::_Expectation ); |
|
4
|
|
|
|
|
4
|
|
|
4
|
|
|
|
|
1548
|
|
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub will_write_sysread_buffer |
282
|
|
|
|
|
|
|
{ |
283
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
284
|
0
|
|
|
|
|
0
|
my ( $fh, $data ) = @_; |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
return $self->will_also( sub { |
287
|
0
|
|
|
0
|
|
0
|
Test::Future::IO->write_sysread_buffer( $fh, $data ); |
288
|
0
|
|
|
|
|
0
|
}); |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub will_write_sysread_buffer_later |
292
|
|
|
|
|
|
|
{ |
293
|
1
|
|
|
1
|
|
39
|
my $self = shift; |
294
|
1
|
|
|
|
|
4
|
my ( $fh, $data ) = @_; |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
return $self->will_also_later( sub { |
297
|
1
|
|
|
1
|
|
1272
|
Test::Future::IO->write_sysread_buffer( $fh, $data ); |
298
|
1
|
|
|
|
|
13
|
}); |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
=head1 TODO |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=over 4 |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
=item * |
307
|
|
|
|
|
|
|
|
308
|
|
|
|
|
|
|
Provision of a mock filehandle object to assist unit tests. |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
=back |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=head1 AUTHOR |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
Paul Evans |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
=cut |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
0x55AA; |