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
|
# -*-perl-*- i/o
use Config;
BEGIN {
if ($^O eq 'MSWin32') {
print "1..0\n";
print "ok 1 # skipped; Win32 supports select() only on sockets\n";
exit;
}
}
use Test; plan tests => 8;
use Event qw(loop unloop);
use Event::Watcher qw(R W);
use Symbol;
#$Event::DebugLevel = 3;
eval { Event->io };
ok $@, "/nothing to watch/";
eval { Event->io(fd => \*STDIN, cb => \&die, poll => 0) };
ok $@, "/nothing to watch/";
my $noticed_bogus_fd=0;
my $bogus_timeout=0;
my $bogus = Event->io(desc => 'oops', poll => 'r', fd => 123,
timeout => .1, cb => sub {
++$bogus_timeout;
});
$SIG{__WARN__} = sub {
my $is_it = $_[0] =~ m/\'oops\' was unexpectedly/;
if ($is_it) {
++$noticed_bogus_fd;
} else {
warn $_[0]
}
};
sub new_pipe {
my ($cnt) = @_;
my ($r,$w) = (gensym, gensym);
pipe($r,$w);
Event->io(desc => "r", poll => 'r', fd => $r, cb => sub {
my $e = shift;
my $w=$e->w;
if ($e->got & R) {
my $buf;
my $got = sysread $w->fd, $buf, 1;
die "sysread: $!"
if !defined $got;
die "sysread: pipe closed?"
if $got == 0;
++$$cnt;
}
});
Event->io(desc => 'w', poll => 'w', fd => $w, cb => sub {
my $e = shift;
my $w=$e->w;
if ($e->got & W) {
my $got = syswrite $w->fd, '.', 1;
die "syswrite: $!"
if !defined $got;
die "syswrite: pipe closed?"
if $got == 0;
}
});
}
my $count = 0;
new_pipe(\$count);
my $hit=0;
my $once = Event->io(timeout => .01, repeat => 0, cb => sub { ++$hit });
Event->io(timeout => 2, repeat => 0,
cb => sub {
ok $count > 0;
ok $hit, 1;
ok $once->timeout, 0;
unloop;
});
loop();
my $bogus_fd_detection;
if ($Config{osname} eq 'darwin' or $Config{archname} =~ m/^armv5tejl/) {
$bogus_fd_detection = 'Cannot detect bogus file descriptors';
}
skip $bogus_fd_detection, $noticed_bogus_fd, 1;
skip $bogus_fd_detection, !defined $bogus->fd;
ok $bogus_timeout > 0;
|
