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
|
#!/usr/bin/perl
use strict;
use warnings;
use IO::Async::Test;
use Test::More;
use Test::Fatal;
use POSIX qw( ENOENT EBADF );
use IO::Async::OS;
plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK;
use IO::Async::Loop;
# Need to look this up, so we don't hardcode the message in the test script
# This might cause locale issues
use constant ENOENT_MESSAGE => do { local $! = ENOENT; "$!" };
my $loop = IO::Async::Loop->new_builtin;
testing_loop( $loop );
ok( exception { $loop->spawn_child( badoption => 1 ); }, 'Bad option to spawn fails' );
ok( exception { $loop->spawn_child( code => sub { 1 }, command => "hello" ); },
'Both code and command options to spawn fails' );
ok( exception { $loop->spawn_child( on_exit => sub { 1 } ); }, 'Bad option to spawn fails' );
{
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
code => sub { return 42; },
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after spawn CODE' );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after spawn CODE' );
is( ($exitcode >> 8), 42, 'WEXITSTATUS($exitcode) after spawn CODE' );
# dollarbang isn't interesting here
is( $dollarat, '', '$dollarat after spawn CODE' );
}
my $ENDEXIT = 10;
END { exit $ENDEXIT if defined $ENDEXIT; }
{
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
code => sub { return 0; },
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after spawn CODE with END' );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after spawn CODE with END' );
# If this comes out as 10 then the END block ran and we fail.
is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after spawn CODE with END' );
# dollarbang isn't interesting here
is( $dollarat, '', '$dollarat after spawn CODE with END' );
}
{
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
code => sub { die "An exception here\n"; },
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after spawn CODE with die with END' );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after spawn CODE with die with END' );
is( ($exitcode >> 8), 255, 'WEXITSTATUS($exitcode) after spawn CODE with die with END' );
# dollarbang isn't interesting here
is( $dollarat, "An exception here\n", '$dollarat after spawn CODE with die with END' );
}
undef $ENDEXIT;
# We need a command that just exits immediately with 0
my $true;
foreach (qw( /bin/true /usr/bin/true )) {
$true = $_, last if -x $_;
}
# Didn't find a likely-looking candidate. We'll fake one using perl itself
$true = "$^X -e 1" if !defined $true;
{
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
command => $true,
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after spawn '.$true );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after spawn '.$true );
is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after spawn '.$true );
is( $dollarbang+0, 0, '$dollarbang after spawn '.$true );
is( $dollarat, '', '$dollarat after spawn '.$true );
}
# Just be paranoid in case anyone actually has this
my $donotexist = "/bin/donotexist";
$donotexist .= "X" while -e $donotexist;
{
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
command => $donotexist,
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after spawn donotexist' );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after spawn donotexist' );
is( ($exitcode >> 8), 255, 'WEXITSTATUS($exitcode) after spawn donotexist' );
is( $dollarbang+0, ENOENT, '$dollarbang numerically after spawn donotexist' );
is( "$dollarbang", ENOENT_MESSAGE, '$dollarbang string after spawn donotexist' );
is( $dollarat, '', '$dollarat after spawn donotexist' );
}
{
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
command => [ $^X, "-e", "exit 14" ],
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after spawn ARRAY' );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after spawn ARRAY' );
is( ($exitcode >> 8), 14, 'WEXITSTATUS($exitcode) after spawn ARRAY' );
is( $dollarbang+0, 0, '$dollarbang after spawn ARRAY' );
is( $dollarat, '', '$dollarat after spawn ARRAY' );
}
{
my( $pipe_r, $pipe_w ) = IO::Async::OS->pipepair or die "Cannot pipepair - $!";
my ( $exited_pid, $exitcode, $dollarbang, $dollarat );
my $spawned_pid = $loop->spawn_child(
code => sub { return $pipe_w->syswrite( "test" ); },
on_exit => sub { ( $exited_pid, $exitcode, $dollarbang, $dollarat ) = @_; }
);
wait_for { defined $exited_pid };
is( $exited_pid, $spawned_pid, '$exited_pid == $spawned_pid after pipe close test' );
ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after pipe close test' );
is( ($exitcode >> 8), 255, 'WEXITSTATUS($exitcode) after pipe close test' );
is( $dollarbang+0, EBADF, '$dollarbang numerically after pipe close test' );
is( $dollarat, '', '$dollarat after pipe close test' );
}
done_testing;
|
