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