diff options
Diffstat (limited to 't/31loop-spawnchild.t')
| -rw-r--r-- | t/31loop-spawnchild.t | 168 |
1 files changed, 168 insertions, 0 deletions
diff --git a/t/31loop-spawnchild.t b/t/31loop-spawnchild.t new file mode 100644 index 0000000..1cac1d9 --- /dev/null +++ b/t/31loop-spawnchild.t @@ -0,0 +1,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; |