# Objective: # ---------- # # This script will trigger the destructor of still # pending events and they should indeed be deleted and # cleaned up. use strict; use warnings; use IO::Socket; use Event::Lib; use Test; BEGIN { plan tests => 6; } my $PATH = "t/sock-$$"; my $pid = fork; die "couldn't fork: $!" unless defined $pid; $SIG{PIPE} = 'IGNORE'; select STDERR; unless ($pid) { # CHILD sleep 1; for my $try (1..2) { my $real_client = IO::Socket::UNIX->new(Peer => $PATH, Blocking => 0) or die "child: Can't open $PATH: $@"; $real_client->autoflush(1); for (1..3) { $real_client->syswrite("foobar"); my $read = $real_client->sysread(my $buf, 1024); } $real_client->close; select undef, undef, undef, 0.5; } exit; } else { # PARENT my $sock = IO::Socket::UNIX->new( Blocking => 0, Local => $PATH, Listen => 1, ) or die "parent: Can't open $PATH: $@"; $sock->listen() or die $!; my $ctx = { sock => $sock }; my $e = event_new($sock, EV_READ|EV_PERSIST, \&handle_incoming, $ctx); $ctx->{incoming_event} = $e; $e->add; event_mainloop(); wait; } sub handle_incoming { my ($e, $e_type, $ctx) = @_; $ctx->{fh}->close if exists $ctx->{fh}; $ctx->{fh} = $ctx->{sock}->accept() or die $!; $ctx->{read_event} = event_new($ctx->{fh}, EV_READ, \&do_read, $ctx); $ctx->{write_event} = event_new($ctx->{fh}, EV_WRITE, \&do_write, $ctx); $ctx->{read_event}->add; } my $ok = 0; sub do_read { my ($e, $e_type, $ctx) = @_; my $read = sysread($ctx->{fh}, my $buf, 1024); if (defined $read) { if ($read) { $ok++; ok($buf, "foobar"); $ctx->{write_event}->add; exit if $ok == 6; } else { return; } } else { return; } } sub do_write { my ($e, $e_type, $ctx) = @_; my $sent = syswrite($ctx->{fh}, "ok", 2, 0); unless (defined $sent) { return; } $ctx->{read_event}->add; } END { unlink $PATH; }