X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fspawn.t;h=ff95ae8eac7845e04c015cecd3bd30425756495f;hb=ee8746e6db4dbe5a6cdb0d6080f467bc27693b3a;hp=6168c1f6171c83919efefa91d7194a5a8b069c1b;hpb=e01fe4f05196b56775fffffe23572ec648b14ec6;p=public-inbox.git diff --git a/t/spawn.t b/t/spawn.t index 6168c1f6..ff95ae8e 100644 --- a/t/spawn.t +++ b/t/spawn.t @@ -1,10 +1,11 @@ -# Copyright (C) 2015-2021 all contributors +#!perl -w +# Copyright (C) all contributors # License: AGPL-3.0+ -use strict; -use warnings; +use v5.12; use Test::More; use PublicInbox::Spawn qw(which spawn popen_rd); -use PublicInbox::Sigfd; +require PublicInbox::Sigfd; +require PublicInbox::DS; { my $true = which('true'); @@ -24,12 +25,22 @@ SKIP: { is(waitpid($pid, 0), $pid, 'waitpid succeeds on spawned process'); is($?, 0, 'true exited successfully'); pipe(my ($r, $w)) or BAIL_OUT; - $pid = eval { spawn(['true'], undef, { pgid => 1, 2 => $w }) }; + + # Find invalid PID to try to join its process group. + my $wrong_pgid = 1; + for (my $i=0x7fffffff; $i >= 2; $i--) { + if (kill(0, $i) == 0) { + $wrong_pgid = $i; + last; + } + } + + # Test spawn behavior when it can't join the requested process group. + $pid = eval { spawn(['true'], undef, { pgid => $wrong_pgid, 2 => $w }) }; close $w; my $err = do { local $/; <$r> }; - # diag "$err ($@)"; if (defined $pid) { - waitpid($pid, 0) if defined $pid; + waitpid($pid, 0); isnt($?, 0, 'child error (pure-Perl)'); } else { ok($@, 'exception raised'); @@ -54,7 +65,7 @@ EOF my $rd = popen_rd([$^X, '-e', $script]); diag 'waiting for child to reap grandchild...'; chomp(my $line = readline($rd)); - my ($rdy, $pid) = split(' ', $line); + my ($rdy, $pid) = split(/ /, $line); is($rdy, 'RDY', 'got ready signal, waitpid(-1) works in child'); ok(kill('CHLD', $pid), 'sent SIGCHLD to child'); is(readline($rd), "HI\n", '$SIG{CHLD} works in child'); @@ -129,13 +140,13 @@ EOF { # ->CLOSE vs ->DESTROY waitpid caller distinction my @c; - my $fh = popen_rd(['true'], undef, { cb => sub { @c = caller } }); + my $fh = popen_rd(['true'], undef, { cb_arg => [sub { @c = caller }] }); ok(close($fh), '->CLOSE fired and successful'); ok(scalar(@c), 'callback fired by ->CLOSE'); ok(grep(!m[/PublicInbox/DS\.pm\z], @c), 'callback not invoked by DS'); @c = (); - $fh = popen_rd(['true'], undef, { cb => sub { @c = caller } }); + $fh = popen_rd(['true'], undef, { cb_arg => [sub { @c = caller }] }); undef $fh; # ->DESTROY ok(scalar(@c), 'callback fired by ->DESTROY'); ok(grep(!m[/PublicInbox/ProcessPipe\.pm\z], @c), @@ -145,8 +156,9 @@ EOF { # children don't wait on siblings use POSIX qw(_exit); pipe(my ($r, $w)) or BAIL_OUT $!; - my $cb = sub { warn "x=$$\n" }; - my $fh = popen_rd(['cat'], undef, { 0 => $r, cb => $cb }); + my @arg; + my $cb = [ sub { @arg = @_; warn "x=$$\n" }, 'hi' ]; + my $fh = popen_rd(['cat'], undef, { 0 => $r, cb_arg => $cb }); my $pp = tied *$fh; my $pid = fork // BAIL_OUT $!; local $SIG{__WARN__} = sub { _exit(1) }; @@ -162,6 +174,9 @@ EOF close $w; close $fh; is($?, 0, 'cat exited'); + is(scalar(@arg), 2, 'callback got args'); + is($arg[1], 'hi', 'passed arg'); + like($arg[0], qr/\A\d+\z/, 'PID'); is_deeply(\@w, [ "x=$$\n" ], 'callback fired from owner'); } @@ -184,6 +199,30 @@ SKIP: { isnt($?, 0, 'non-zero exit status'); } -done_testing(); +SKIP: { + require PublicInbox::SpawnPP; + require File::Temp; + my $tmp = File::Temp->newdir('spawnpp-XXXX', TMPDIR => 1); + my $cmd = [ qw(/bin/sh -c), 'echo $HI >foo' ]; + my $env = [ 'HI=hihi' ]; + my $rlim = []; + my $pgid = -1; + my $pid = PublicInbox::SpawnPP::pi_fork_exec([], '/bin/sh', $cmd, $env, + $rlim, "$tmp", $pgid); + is(waitpid($pid, 0), $pid, 'spawned process exited'); + is($?, 0, 'no error'); + open my $fh, '<', "$tmp/foo" or die "open: $!"; + is(readline($fh), "hihi\n", 'env+chdir worked for SpawnPP'); + close $fh; + unlink("$tmp/foo") or die "unlink: $!"; + { + local $ENV{MOD_PERL} = 1; + $pid = PublicInbox::SpawnPP::pi_fork_exec([], + '/bin/sh', $cmd, $env, $rlim, "$tmp", $pgid); + } + is(waitpid($pid, 0), $pid, 'spawned process exited'); + open $fh, '<', "$tmp/foo" or die "open: $!"; + is(readline($fh), "hihi\n", 'env+chdir SpawnPP under (faked) MOD_PERL'); +} -1; +done_testing();