1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use IO::Async::Test; 7 8use Test::More; 9use Test::Metrics::Any; 10 11use POSIX qw( SIGINT ); 12 13use IO::Async::Loop; 14use IO::Async::OS; 15 16plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK; 17 18my $loop = IO::Async::Loop->new_builtin; 19 20testing_loop( $loop ); 21 22{ 23 my $exitcode; 24 $loop->fork( 25 code => sub { return 5; }, 26 on_exit => sub { ( undef, $exitcode ) = @_ }, 27 ); 28 29 wait_for { defined $exitcode }; 30 31 ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after child exit' ); 32 is( ($exitcode >> 8), 5, 'WEXITSTATUS($exitcode) after child exit' ); 33} 34 35{ 36 my $exitcode; 37 $loop->fork( 38 code => sub { die "error"; }, 39 on_exit => sub { ( undef, $exitcode ) = @_ }, 40 ); 41 42 wait_for { defined $exitcode }; 43 44 ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after child die' ); 45 is( ($exitcode >> 8), 255, 'WEXITSTATUS($exitcode) after child die' ); 46} 47 48SKIP: { 49 skip "This OS does not have signals", 1 unless IO::Async::OS->HAVE_SIGNALS; 50 51 local $SIG{INT} = sub { exit( 22 ) }; 52 53 my $exitcode; 54 $loop->fork( 55 code => sub { kill SIGINT, $$ }, 56 on_exit => sub { ( undef, $exitcode ) = @_ }, 57 ); 58 59 wait_for { defined $exitcode }; 60 61 is( ($exitcode & 0x7f), SIGINT, 'WTERMSIG($exitcode) after child SIGINT' ); 62} 63 64SKIP: { 65 skip "This OS does not have signals", 2 unless IO::Async::OS->HAVE_SIGNALS; 66 67 local $SIG{INT} = sub { exit( 22 ) }; 68 69 my $exitcode; 70 $loop->fork( 71 code => sub { kill SIGINT, $$ }, 72 on_exit => sub { ( undef, $exitcode ) = @_ }, 73 keep_signals => 1, 74 ); 75 76 wait_for { defined $exitcode }; 77 78 ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after child SIGINT with keep_signals' ); 79 is( ($exitcode >> 8), 22, 'WEXITSTATUS($exitcode) after child SIGINT with keep_signals' ); 80} 81 82{ 83 my $exitcode; 84 85 $loop->fork( 86 code => sub { 87 my $innerloop = IO::Async::Loop->new; 88 return 0 if $innerloop != $loop; # success 89 return 1; 90 }, 91 on_exit => sub { ( undef, $exitcode ) = @_ }, 92 ); 93 94 wait_for { defined $exitcode }; 95 96 ok( $exitcode == 0, 'IO::Async::Loop->new inside forked process code gets new loop instance' ); 97} 98 99# Metrics 100SKIP: { 101 skip "Metrics are unavailable" unless $IO::Async::Metrics::METRICS; 102 is_metrics_from( 103 sub { $loop->fork( code => sub {}, on_exit => sub {} ) }, 104 { io_async_forks => 1 }, 105 '$loop->fork increments fork counter' 106 ); 107} 108 109done_testing; 110