The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Resources (mem/fd) shouldn't leak.
use warnings;
use strict;
use t::share;

if ($^O !~ /linux/i) {
    plan skip_all => 'require /proc';
}

if ( not $ENV{TEST_AUTHOR} ) {
    my $msg = 'Author test.  Set $ENV{TEST_AUTHOR} to a true value to run.';
    plan( skip_all => $msg );
}

if ($INC{'Devel/Cover.pm'}) {
    plan skip_all => 'unable to test under Devel::Cover';
}
plan tests => 2;

leaktest('create_stream');

sub create_stream {
    IO::Stream->new({
        host        => '127.0.0.1',
        port        => 1234,
        cb          => sub {},
        wait_for    => 0,
    })->close();
}

sub leaktest {
    my $test = shift;
    my %arg  = (init=>100, test=>1000, max_mem_diff=>100, diag=>0, @_);
    my $code = do { no strict 'refs'; \&$test };
    $code->() for 1 .. $arg{init};
    my $fd  = FD_used();
    my $mem = MEM_used();
    $code->() for 1 .. $arg{test};
    diag sprintf "---- MEM\nWAS: %d\nNOW: %d\n", $mem, MEM_used() if $arg{diag};
    ok( abs(MEM_used() - $mem) < $arg{max_mem_diff},  "MEM: $test" );
    is(FD_used(), $fd,                                " FD: $test" );
}

sub MEM_used {
    open my $f, '<', '/proc/self/status';
    my $status = join q{}, <$f>;
    return ($status =~ /VmRSS:\s*(\d*)/)[0];
};

sub FD_used {
    opendir my $fd, '/proc/self/fd' or croak "opendir: $!";
    return @{[ readdir $fd ]} - 2;
};