1#!/usr/bin/perl 2 3use strict; 4use warnings; 5 6use IO::Async::Test; 7 8use Test::More; 9use Test::Fatal; 10 11use IO::Async::Loop; 12use IO::Async::OS; 13 14plan skip_all => "POSIX fork() is not available" unless IO::Async::OS->HAVE_POSIX_FORK; 15 16my $loop = IO::Async::Loop->new_builtin; 17 18testing_loop( $loop ); 19 20my ( $exitcode, $child_out, $child_err ); 21 22$loop->run_child( 23 code => sub { 0 }, 24 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 25); 26 27undef $exitcode; 28wait_for { defined $exitcode }; 29 30ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { 0 }' ); 31is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after sub { 0 }' ); 32is( $child_out, "", '$child_out after sub { 0 }' ); 33is( $child_err, "", '$child_err after sub { 0 }' ); 34 35$loop->run_child( 36 code => sub { 3 }, 37 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 38); 39 40undef $exitcode; 41wait_for { defined $exitcode }; 42 43ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { 3 }' ); 44is( ($exitcode >> 8), 3, 'WEXITSTATUS($exitcode) after sub { 3 }' ); 45is( $child_out, "", '$child_out after sub { 3 }' ); 46is( $child_err, "", '$child_err after sub { 3 }' ); 47 48$loop->run_child( 49 command => [ $^X, "-e", '1' ], 50 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 51); 52 53undef $exitcode; 54wait_for { defined $exitcode }; 55 56ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl -e 1' ); 57is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl -e 1' ); 58is( $child_out, "", '$child_out after perl -e 1' ); 59is( $child_err, "", '$child_err after perl -e 1' ); 60 61$loop->run_child( 62 command => [ $^X, "-e", 'exit 5' ], 63 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 64); 65 66undef $exitcode; 67wait_for { defined $exitcode }; 68 69ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl -e exit 5' ); 70is( ($exitcode >> 8), 5, 'WEXITSTATUS($exitcode) after perl -e exit 5' ); 71is( $child_out, "", '$child_out after perl -e exit 5' ); 72is( $child_err, "", '$child_err after perl -e exit 5' ); 73 74$loop->run_child( 75 code => sub { print "hello\n"; 0 }, 76 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 77); 78 79undef $exitcode; 80wait_for { defined $exitcode }; 81 82ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after sub { print }' ); 83is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after sub { print }' ); 84is( $child_out, "hello\n", '$child_out after sub { print }' ); 85is( $child_err, "", '$child_err after sub { print }' ); 86 87$loop->run_child( 88 command => [ $^X, "-e", 'print "goodbye\n"' ], 89 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 90); 91 92undef $exitcode; 93wait_for { defined $exitcode }; 94 95ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDOUT' ); 96is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDOUT' ); 97is( $child_out, "goodbye\n", '$child_out after perl STDOUT' ); 98is( $child_err, "", '$child_err after perl STDOUT' ); 99 100$loop->run_child( 101 command => [ $^X, "-e", 'print STDOUT "output\n"; print STDERR "error\n";' ], 102 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 103); 104 105undef $exitcode; 106wait_for { defined $exitcode }; 107 108ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDOUT/STDERR' ); 109is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDOUT/STDERR' ); 110is( $child_out, "output\n", '$child_out after perl STDOUT/STDERR' ); 111is( $child_err, "error\n", '$child_err after perl STDOUT/STDERR' ); 112 113# perl -pe 1 behaves like cat; copies STDIN to STDOUT 114 115$loop->run_child( 116 command => [ $^X, "-pe", '1' ], 117 stdin => "some data\n", 118 on_finish => sub { ( undef, $exitcode, $child_out, $child_err ) = @_; }, 119); 120 121undef $exitcode; 122wait_for { defined $exitcode }; 123 124ok( ($exitcode & 0x7f) == 0, 'WIFEXITED($exitcode) after perl STDIN->STDOUT' ); 125is( ($exitcode >> 8), 0, 'WEXITSTATUS($exitcode) after perl STDIN->STDOUT' ); 126is( $child_out, "some data\n", '$child_out after perl STDIN->STDOUT' ); 127is( $child_err, "", '$child_err after perl STDIN->STDOUT' ); 128 129ok( exception { $loop->run_child( 130 command => [ $^X, "-e", 1 ] 131 ) }, 132 'Missing on_finish fails' 133); 134 135ok( exception { $loop->run_child( 136 command => [ $^X, "-e", 1 ], 137 on_finish => "hello" 138 ) }, 139 'on_finish not CODE ref fails' 140); 141 142ok( exception { $loop->run_child( 143 command => [ $^X, "-e", 1 ], 144 on_finish => sub {}, 145 on_exit => sub {}, 146 ) }, 147 'on_exit parameter fails' 148); 149 150ok( exception { $loop->run_child( 151 command => [ $^X, "-e", 1 ], 152 on_finish => sub {}, 153 some_key_you_fail => 1 154 ) }, 155 'unrecognised key fails' 156); 157 158done_testing; 159