71 lines
1.8 KiB
Perl
71 lines
1.8 KiB
Perl
use strict;
|
|
use warnings;
|
|
|
|
BEGIN {
|
|
use Config;
|
|
if (! $Config{'useithreads'}) {
|
|
print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
|
|
exit(0);
|
|
}
|
|
}
|
|
|
|
use ExtUtils::testlib;
|
|
|
|
sub ok {
|
|
my ($id, $ok, $name) = @_;
|
|
|
|
# You have to do it this way or VMS will get confused.
|
|
if ($ok) {
|
|
print("ok $id - $name\n");
|
|
} else {
|
|
print("not ok $id - $name\n");
|
|
printf("# Failed test at line %d\n", (caller)[2]);
|
|
}
|
|
|
|
return ($ok);
|
|
}
|
|
|
|
BEGIN {
|
|
$| = 1;
|
|
print("1..15\n"); ### Number of tests that will be run ###
|
|
};
|
|
|
|
use threads;
|
|
ok(1, 1, 'Loaded');
|
|
|
|
### Start of Testing ###
|
|
|
|
ok(2, scalar @{[threads->list()]} == 0, 'No threads yet');
|
|
|
|
threads->create(sub {})->join();
|
|
ok(3, scalar @{[threads->list()]} == 0, 'Empty thread list after join');
|
|
|
|
my $thread = threads->create(sub {});
|
|
ok(4, scalar(threads->list()) == 1, 'Non-empty thread list');
|
|
ok(5, threads->list() == 1, 'Non-empty thread list');
|
|
$thread->join();
|
|
ok(6, scalar @{[threads->list()]} == 0, 'Thread list empty again');
|
|
ok(7, threads->list() == 0, 'Thread list empty again');
|
|
|
|
$thread = threads->create(sub {
|
|
ok(8, threads->list() == 1, 'Non-empty thread list in thread');
|
|
ok(9, threads->self == (threads->list())[0], 'Self in thread list')
|
|
});
|
|
|
|
threads->yield; # help out non-preemptive thread implementations
|
|
sleep 1;
|
|
|
|
ok(10, scalar(threads->list()) == 1, 'Thread count 1');
|
|
ok(11, threads->list() == 1, 'Thread count 1');
|
|
my $cnt = threads->list();
|
|
ok(12, $cnt == 1, 'Thread count 1');
|
|
my ($thr_x) = threads->list();
|
|
ok(13, $thread == $thr_x, 'Thread in list');
|
|
$thread->join();
|
|
ok(14, scalar @{[threads->list()]} == 0, 'Thread list empty');
|
|
ok(15, threads->list() == 0, 'Thread list empty');
|
|
|
|
exit(0);
|
|
|
|
# EOF
|