use strict;
use warnings;
# should load threads.pm before Test::Builder in
# other case Test::Builder wouldn't share test number
BEGIN {
use Config;
use constant USETHREADS => ($] >= 5.008 && $Config{useithreads});
require threads if USETHREADS;
}
# XXX: at the moment testing only the survival of GTop objects with
# threads, see the TODO file for remaining parts
my $threads;
BEGIN {
use Test::More;
if (USETHREADS) {
$threads = 3;
plan tests => 2 + ($threads+1);
}
else {
plan skip_all => 'perl 5.8+ w/ ithreads is required';
}
}
BEGIN { use_ok('GTop') };
# the object is intentionally global, so perl won't destroy it right
# away
our $gtop = GTop->new;
access_test();
# as the new threads are spawned they will inherit the count from the
# main thread
threads->new(\&access_test)->detach for 1..$threads;
sub access_test {
print "# $$ mem size: \n";
my $proc_mem = $gtop->proc_mem($$);
my $mem_size = $proc_mem->size;
print "# $$ mem size: $mem_size\n";
ok $mem_size > 0;
}
# workaround the situations where the main thread exits before the
# child threads, which shouldn't be a problem since all threads are
# detached, but something is broken in perl
select(undef, undef, undef, 0.25); # sleep 0.25sec
END { ok 1; }