1#!/usr/bin/perl
2
3BEGIN {
4  unless ($ENV{AUTHOR_TESTING}) {
5    require Test::More;
6    Test::More::plan(skip_all => 'these tests are for testing by the author');
7  }
8}
9
10
11use strict;
12use warnings;
13
14use Test::More;
15BEGIN {
16    plan skip_all => 'memory leak test is linux-specific' unless $^O eq 'linux';
17}
18
19plan tests => 2;
20
21use lib 'lib';
22
23use t::Utils;
24rebuild_tfiles();
25
26use Ubic;
27
28local_ubic( service_dirs => [qw( t/service/freaks )] );
29
30# These tests check that ubic-ping don't waste memory in long runs.
31# Ubic compiles service descriptions on-the-fly, every time with new package name, so memory leaks are possible.
32# They happened before and can come back again after some unfortunate refactoring...
33# (currently, Ubic caches every service instance forever, though, and ubic-ping don't compile simple services at all, just multiservices).
34
35sub mem_usage {
36    my $stat = slurp("/proc/$$/statm");
37    my ($mem) = $stat =~ /^(\d+)/;
38    return $mem;
39}
40
41{
42    my $check_status = sub {
43        my $status = Ubic->cached_status('multi-broken.abc');
44    };
45
46    $check_status->();
47
48    my $mem = mem_usage;
49    $check_status->() for 1..10_000;
50
51    cmp_ok(mem_usage() - $mem, '<', 50);
52}
53
54{
55    my $check_status = sub {
56        eval {
57            my $status = Ubic->cached_status('multi-broken.broken.blah');
58        };
59    };
60
61    $check_status->();
62
63    my $mem = mem_usage;
64    $check_status->() for 1..10_000;
65
66    cmp_ok(mem_usage() - $mem, '<', 50);
67}
68