/usr/share/perl5/IO/Async/Test.pm is in libio-async-perl 0.64-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 | # You may distribute under the terms of either the GNU General Public License
# or the Artistic License (the same terms as Perl itself)
#
# (C) Paul Evans, 2007-2012 -- leonerd@leonerd.org.uk
package IO::Async::Test;
use strict;
use warnings;
our $VERSION = '0.64';
use Exporter 'import';
our @EXPORT = qw(
testing_loop
wait_for
wait_for_stream
);
=head1 NAME
C<IO::Async::Test> - utility functions for use in test scripts
=head1 SYNOPSIS
use Test::More tests => 1;
use IO::Async::Test;
use IO::Async::Loop;
my $loop = IO::Async::Loop->new;
testing_loop( $loop );
my $result;
$loop->do_something(
some => args,
on_done => sub {
$result = the_outcome;
}
);
wait_for { defined $result };
is( $result, what_we_expected, 'The event happened' );
...
my $buffer = "";
my $handle = IO::Handle-> ...
wait_for_stream { length $buffer >= 10 } $handle => $buffer;
is( substr( $buffer, 0, 10, "" ), "0123456789", 'Buffer was correct' );
=head1 DESCRIPTION
This module provides utility functions that may be useful when writing test
scripts for code which uses C<IO::Async> (as well as being used in the
C<IO::Async> test scripts themselves).
Test scripts are often synchronous by nature; they are a linear sequence of
actions to perform, interspersed with assertions which check for given
conditions. This goes against the very nature of C<IO::Async> which, being an
asynchronisation framework, does not provide a linear stepped way of working.
In order to write a test, the C<wait_for> function provides a way of
synchronising the code, so that a given condition is known to hold, which
would typically signify that some event has occured, the outcome of which can
now be tested using the usual testing primitives.
Because the primary purpose of C<IO::Async> is to provide IO operations on
filehandles, a great many tests will likely be based around connected pipes or
socket handles. The C<wait_for_stream> function provides a convenient way
to wait for some content to be written through such a connected stream.
=cut
my $loop;
END { undef $loop }
=head1 FUNCTIONS
=cut
=head2 testing_loop( $loop )
Set the C<IO::Async::Loop> object which the C<wait_for> function will loop
on.
=cut
sub testing_loop
{
$loop = shift;
}
=head2 wait_for( $condfunc )
Repeatedly call the C<loop_once> method on the underlying loop (given to the
C<testing_loop> function), until the given condition function callback
returns true.
To guard against stalled scripts, if the loop indicates a timeout for 10
consequentive seconds, then an error is thrown.
=cut
sub wait_for(&)
{
my ( $cond ) = @_;
my ( undef, $callerfile, $callerline ) = caller;
my $timedout = 0;
my $timerid = $loop->watch_time(
after => 10,
code => sub { $timedout = 1 },
);
$loop->loop_once( 1 ) while !$cond->() and !$timedout;
if( $timedout ) {
die "Nothing was ready after 10 second wait; called at $callerfile line $callerline\n";
}
else {
$loop->unwatch_time( $timerid );
}
}
=head2 wait_for_stream( $condfunc, $handle, $buffer )
As C<wait_for>, but will also watch the given IO handle for readability, and
whenever it is readable will read bytes in from it into the given buffer. The
buffer is NOT initialised when the function is entered, in case data remains
from a previous call.
C<$buffer> can also be a CODE reference, in which case it will be invoked
being passed data read from the handle, whenever it is readable.
=cut
sub wait_for_stream(&$$)
{
my ( $cond, $handle, undef ) = @_;
my $on_read;
if( ref $_[2] eq "CODE" ) {
$on_read = $_[2];
}
else {
my $varref = \$_[2];
$on_read = sub { $$varref .= $_[0] };
}
$loop->watch_io(
handle => $handle,
on_read_ready => sub {
my $ret = $handle->sysread( my $buffer, 8192 );
if( !defined $ret ) {
die "Read failed on $handle - $!\n";
}
elsif( $ret == 0 ) {
die "Read returned EOF on $handle\n";
}
$on_read->( $buffer );
}
);
# Have to defeat the prototype... grr I hate these
&wait_for( $cond );
$loop->unwatch_io(
handle => $handle,
on_read_ready => 1,
);
}
=head1 AUTHOR
Paul Evans <leonerd@leonerd.org.uk>
=cut
0x55AA;
|