File: post.t

package info (click to toggle)
libmojolicious-plugin-cgi-perl 0.36-1
  • links: PTS, VCS
  • area: main
  • in suites: stretch
  • size: 208 kB
  • ctags: 17
  • sloc: perl: 300; makefile: 2
file content (59 lines) | stat: -rw-r--r-- 1,930 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
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;