use warnings;
use strict;
use Test::More;
use Test::Mojo;
# http://cpantesters.org/cpan/report/dc79de2e-c956-11e4-9245-4861e0bfc7aa
# http://cpantesters.org/cpan/report/676eae4c-24f6-11e5-ad16-fd611bfff594
# http://cpantesters.org/cpan/report/908763b4-24f6-11e5-8c9c-b46a1bfff594
# http://cpantesters.org/cpan/report/1c1f3f16-8a17-11e5-b552-e159351a082c
plan skip_all => 'TEST_PIPES=1; No idea how to test this consistently' unless $ENV{TEST_PIPES};
my @pipes = get_pipes();
my %LSOF_PIPE; # Map lsof DEVICE and NAME to same pipe.
use Mojolicious::Lite;
plugin CGI => ['/postman' => 't/cgi-bin/postman'];
my $t = Test::Mojo->new;
$t->post_ok('/postman', {}, "some\ndata\n")->status_is(200)->content_like(qr{^\d+\n--- some\n--- data\n$});
my $pid = $t->tx->res->body =~ /(\d+)/ ? $1 : 0;
ok !(kill 0, $pid), "child $pid is taken care of ($$, @{[time]})"
or is waitpid($pid, 0), $pid, "waitpid $pid, 0 ($$, @{[time]})";
is_deeply \@pipes, [get_pipes()], 'no leaky leaks';
sub get_pipes {
return diag "test for leaky pipes under Debian build", 1 if $ENV{DEBIAN_BUILD};
my @pipes;
if (-d "/proc/$$/fd") {
for my $fd (glob "/proc/$$/fd/*") {
my $pts = readlink sprintf '/proc/%s/fd/%s', $$, +(split '/', $fd)[-1] or next;
push @pipes, $pts if $pts =~ /pipe:/;
}
}
elsif (`which lsof` =~ /\blsof$/) {
# Output of `lsof` for pipe looks like this:
# COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME
# perl5.18 57806 moejoe 3 PIPE 0xd52803906b02a64f 16384 ->0xd52803907288254f
for (`lsof -p $$`) {
/ PIPE / or next;
my ($device, $name) = /\b(0x[[:xdigit:]]+)/g;
my $pipe = $LSOF_PIPE{$device} || $LSOF_PIPE{$name} || $device;
$LSOF_PIPE{$device} = $LSOF_PIPE{$name} = $pipe;
push @pipes, $pipe;
}
}
else {
diag "unable to test leaky pipes";
}
return sort @pipes;
}
done_testing;