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