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
|
#!/usr/bin/perl -w
#
# This test simulates epoll_wait returning two objects, one of which
# deletes the other before the other is later then processed. If we
# remove the fd from DescriptorMap at the wrong time, then
# Danga::Socket emits warnings. Danga::Socket now delays removing
# from DescriptorMap until later.
use strict;
use Test::More tests => 7;
use Danga::Socket;
use IO::Socket::INET;
use POSIX;
no warnings qw(deprecated);
use vars qw($done $SERVER_PORT $SERVER_ADDR);
BEGIN {
$SERVER_PORT = $ENV{DS_TEST_SERVER_PORT} || 60001;
$SERVER_ADDR = "127.0.0.1:$SERVER_PORT";
}
my $ssock = IO::Socket::INET->new(Listen => 5,
LocalAddr => '127.0.0.1',
LocalPort => $SERVER_PORT,
Proto => 'tcp',
ReuseAddr => 1,
);
diag("Looks like I couldn't create a listen socket at $SERVER_ADDR. If this conflicts with another service on your host, you may like to try setting the DS_TEST_SERVER_PORT environment variable to a free port number") unless $ssock;
ok($ssock, "made server");
my $c1 = IO::Socket::INET->new(PeerAddr => $SERVER_ADDR);
ok($c1, "made client1");
my $sc1 = $ssock->accept;
ok($sc1, "got client1");
my $c2 = IO::Socket::INET->new(PeerAddr => $SERVER_ADDR);
ok($c2, "made client2");
my $sc2 = $ssock->accept;
ok($sc2, "got client2");
my $ds1 = ClientIn->new($c1);
my $ds2 = ClientIn->new($c2);
$ds1->watch_write(1);
$ds2->watch_write(1);
use vars qw($no_warnings);
$no_warnings = 1;
$SIG{__WARN__} = sub {
my $msg = shift;
print STDERR "WARNING: $msg";
$no_warnings = 0;
};
Danga::Socket->EventLoop;
package ClientIn;
use base 'Danga::Socket';
use fields (
'got',
'state',
);
our %set;
our @history;
sub new {
my ($class, $sock) = @_;
my $self = fields::new($class);
$self->SUPER::new($sock); # init base fields
$self->watch_read(1);
$self->{state} = "init";
$self->{got} = "";
$set{$self->{fd}} = $self;
return $self;
}
sub event_write {
my $self = shift;
my $brother_fd = (grep { $_ != $self->{fd} } keys %set)[0];
my $brother = $set{$brother_fd};
push @history, $self->{fd};
if (@history > 10) {
Test::More::ok(scalar(grep { $_ != $self->{fd} } @history) == 0, "only ourselves in the history");
Test::More::ok($main::no_warnings, "no warnings");
exit(0);
}
$brother->close;
}
|
