X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=t%2Fspawn.t;h=6168c1f6171c83919efefa91d7194a5a8b069c1b;hb=d1fd2feb587b34d66227a6cb4f9c8b930812ddbf;hp=558afc289b6277712f754632157525764183cbe4;hpb=b90e8d6e02852c47d0c08198d8c7afb5dbe008d7;p=public-inbox.git diff --git a/t/spawn.t b/t/spawn.t index 558afc28..6168c1f6 100644 --- a/t/spawn.t +++ b/t/spawn.t @@ -5,35 +5,6 @@ use warnings; use Test::More; use PublicInbox::Spawn qw(which spawn popen_rd); use PublicInbox::Sigfd; -use Socket qw(AF_UNIX SOCK_STREAM); - -SKIP: { - my $recv_3fds = PublicInbox::Spawn->can('recv_3fds'); - my $send_3fds = PublicInbox::Spawn->can('send_3fds'); - skip 'Inline::C not enabled', 3 unless $send_3fds && $recv_3fds; - my ($s1, $s2); - socketpair($s1, $s2, AF_UNIX, SOCK_STREAM, 0) or BAIL_OUT $!; - pipe(my ($r, $w)) or BAIL_OUT $!; - my @orig = ($r, $w, $s2); - my @fd = map { fileno($_) } @orig; - ok($send_3fds->(fileno($s1), $fd[0], $fd[1], $fd[2]), - 'FDs sent'); - my (@fds) = $recv_3fds->(fileno($s2)); - is(scalar(@fds), 3, 'got 3 fds'); - use Data::Dumper; diag Dumper(\@fds); - is(scalar(grep(/\A\d+\z/, @fds)), 3, 'all valid FDs'); - my $i = 0; - my @cmp = map { - open my $new, $_, shift(@fds) or BAIL_OUT "open $! $i => $_"; - ($new, shift(@orig), $i++); - } (qw(<&= >&= +<&=)); - while (my ($new, $old, $fd) = splice(@cmp, 0, 3)) { - my @new = stat($new); - my @old = stat($old); - is("$old[0]\0$old[1]", "$new[0]\0$new[1]", - "device/inode matches on received FD:$fd"); - } -} { my $true = which('true'); @@ -47,6 +18,24 @@ SKIP: { is($?, 0, 'true exited successfully'); } +SKIP: { + my $pid = spawn(['true'], undef, { pgid => 0 }); + ok($pid, 'spawned process with new pgid'); + 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 }) }; + close $w; + my $err = do { local $/; <$r> }; + # diag "$err ($@)"; + if (defined $pid) { + waitpid($pid, 0) if defined $pid; + isnt($?, 0, 'child error (pure-Perl)'); + } else { + ok($@, 'exception raised'); + } +} + { # ensure waitpid(-1, 0) and SIGCHLD works in spawned process my $script = <<'EOF'; $| = 1; # unbuffer stdout @@ -106,6 +95,11 @@ EOF { my $fh = popen_rd([qw(printf foo\nbar)]); ok(fileno($fh) >= 0, 'tied fileno works'); + my $tfh = (tied *$fh)->{fh}; + is($tfh->blocking(0), 1, '->blocking was true'); + is($tfh->blocking, 0, '->blocking is false'); + is($tfh->blocking(1), 0, '->blocking was true'); + is($tfh->blocking, 1, '->blocking is true'); my @line = <$fh>; is_deeply(\@line, [ "foo\n", 'bar' ], 'wantarray works on readline'); } @@ -127,6 +121,12 @@ EOF isnt($?, 0, '$? set properly: '.$?); } +{ + local $ENV{GIT_CONFIG} = '/path/to/this/better/not/exist'; + my $fh = popen_rd([qw(env)], { GIT_CONFIG => undef }); + ok(!grep(/^GIT_CONFIG=/, <$fh>), 'GIT_CONFIG clobbered'); +} + { # ->CLOSE vs ->DESTROY waitpid caller distinction my @c; my $fh = popen_rd(['true'], undef, { cb => sub { @c = caller } });