#!/usr/bin/perl -w
use strict;
use constant MAIN_TESTS => 20;
use Test::More tests => MAIN_TESTS + 1;
use Test::Exception;
use IO::Socket::UNIX;
use IO::Async::Notifier;
use IO::Async::Set::GMainLoop;
dies_ok( sub { IO::Async::Set::GMainLoop->new(); },
'No Glib loaded' );
SKIP: { # Don't indent because most of this script is within the block; it would look messy
if( !defined eval { require Glib } ) {
skip "No Glib available", MAIN_TESTS;
exit 0;
}
( my $S1, my $S2 ) = IO::Socket::UNIX->socketpair( AF_UNIX, SOCK_STREAM, PF_UNSPEC ) or
die "Cannot create socket pair - $!";
# Need sockets in nonblocking mode
$S1->blocking( 0 );
$S2->blocking( 0 );
my $readready = 0;
my $writeready = 0;
my $notifier = IO::Async::Notifier->new( handle => $S1,
on_read_ready => sub { $readready = 1; return 0 },
on_write_ready => sub { $writeready = 1; return 0 },
);
my $set = IO::Async::Set::GMainLoop->new();
ok( defined $set, '$set defined' );
is( ref $set, "IO::Async::Set::GMainLoop", 'ref $set is IO::Async::Set::GMainLoop' );
# Empty
my $context = Glib::MainContext->default;
ok( ! $context->pending, 'nothing pending empty' );
# Idle
$set->add( $notifier );
is( $notifier->__memberof_set, $set, '$notifier->__memberof_set == $set' );
dies_ok( sub { $set->add( $notifier ) }, 'adding again produces error' );
$context->iteration( 0 );
ok( ! $context->pending, 'nothing pending idle' );
# Read-ready
$S2->syswrite( "data\n" );
ok( $context->pending, 'pending before readready' );
is( $readready, 0, '$readready before iteration' );
$context->iteration( 0 );
# Ready $S1 to clear the data
$S1->getline(); # ignore return
ok( ! $context->pending, 'nothing pending after readready' );
is( $readready, 1, '$readready after iteration' );
# Write-ready
$notifier->want_writeready( 1 );
ok( $context->pending, 'pending before writeready' );
is( $writeready, 0, '$writeready before iteration' );
$context->iteration( 0 );
$notifier->want_writeready( 0 );
ok( ! $context->pending, 'nothing pending after writeready' );
is( $writeready, 1, '$writeready after iteration' );
# HUP
$readready = 0;
$context->iteration( 0 );
is( $readready, 0, '$readready before HUP' );
close( $S2 );
$readready = 0;
$context->iteration( 0 );
is( $readready, 1, '$readready after HUP' );
# Removal
$set->remove( $notifier );
is( $notifier->__memberof_set, undef, '$notifier->__memberof_set is undef' );
ok( ! $context->pending, 'nothing pending after removal' );
# HUP of pipe
pipe( my ( $P1, $P2 ) ) or die "Cannot pipe() - $!";
my $pipe_io = IO::Handle->new_from_fd( fileno( $P1 ), 'r' );
my $pipe_notifier = IO::Async::Notifier->new( handle => $pipe_io,
on_read_ready => sub { $readready = 1 },
want_writeready => 0,
);
$set->add( $pipe_notifier );
$readready = 0;
$context->iteration( 0 );
is( $readready, 0, '$readready before pipe HUP' );
close( $P2 );
$readready = 0;
$context->iteration( 0 );
is( $readready, 1, '$readready after pipe HUP' );
$set->remove( $pipe_notifier );
} # for SKIP block
syntax highlighted by Code2HTML, v. 0.9.1