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