|
Packit |
b3426c |
use warnings;
|
|
Packit |
b3426c |
use strict;
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
BEGIN {
|
|
Packit |
b3426c |
eval { require threads; };
|
|
Packit |
b3426c |
if($@ =~ /\AThis Perl not built to support threads/) {
|
|
Packit |
b3426c |
require Test::More;
|
|
Packit |
b3426c |
Test::More::plan(skip_all => "non-threading perl build");
|
|
Packit |
b3426c |
}
|
|
Packit |
b3426c |
if($@ ne "") {
|
|
Packit |
b3426c |
require Test::More;
|
|
Packit |
b3426c |
Test::More::plan(skip_all => "threads unavailable");
|
|
Packit |
b3426c |
}
|
|
Packit |
b3426c |
eval { require Thread::Semaphore; };
|
|
Packit |
b3426c |
if($@ ne "") {
|
|
Packit |
b3426c |
require Test::More;
|
|
Packit |
b3426c |
Test::More::plan(skip_all => "Thread::Semaphore unavailable");
|
|
Packit |
b3426c |
}
|
|
Packit |
b3426c |
eval { require threads::shared; };
|
|
Packit |
b3426c |
if($@ ne "") {
|
|
Packit |
b3426c |
require Test::More;
|
|
Packit |
b3426c |
Test::More::plan(skip_all => "threads::shared unavailable");
|
|
Packit |
b3426c |
}
|
|
Packit |
b3426c |
}
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
use threads;
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
BEGIN { unshift @INC, "./t/lib"; }
|
|
Packit |
b3426c |
use Test::More tests => 3;
|
|
Packit |
b3426c |
use Thread::Semaphore ();
|
|
Packit |
b3426c |
use threads::shared;
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
alarm 10; # failure mode may involve an infinite loop
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
sub tsub1 (@) { $_[0] }
|
|
Packit |
b3426c |
sub tsub2 (@) { $_[0] }
|
|
Packit |
b3426c |
sub nsub (@) { $_[0] }
|
|
Packit |
b3426c |
our @three = (3);
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
my $done1 = Thread::Semaphore->new(0);
|
|
Packit |
b3426c |
my $exit1 = Thread::Semaphore->new(0);
|
|
Packit |
b3426c |
my $done2 = Thread::Semaphore->new(0);
|
|
Packit |
b3426c |
my $exit2 = Thread::Semaphore->new(0);
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
my $ok1 :shared;
|
|
Packit |
b3426c |
my $thread1 = threads->create(sub {
|
|
Packit |
b3426c |
my $ok = 1;
|
|
Packit |
b3426c |
require Devel::CallChecker;
|
|
Packit |
b3426c |
require t::LoadXS;
|
|
Packit |
b3426c |
require t::WriteHeader;
|
|
Packit |
b3426c |
t::WriteHeader::write_header("callchecker0", "t", "threads1");
|
|
Packit |
b3426c |
t::LoadXS::load_xs("threads1", "t",
|
|
Packit |
b3426c |
[Devel::CallChecker::callchecker_linkable()]);
|
|
Packit |
b3426c |
eval(q{nsub(@three)}) == 3 or $ok = 0;
|
|
Packit |
b3426c |
eval(q{tsub1(@three)}) == 3 or $ok = 0;
|
|
Packit |
b3426c |
t::threads1::cv_set_call_checker_proto(\&tsub1, "\$");
|
|
Packit |
b3426c |
eval(q{nsub(@three)}) == 3 or $ok = 0;
|
|
Packit |
b3426c |
eval(q{tsub1(@three)}) == 1 or $ok = 0;
|
|
Packit |
b3426c |
$ok1 = $ok;
|
|
Packit |
b3426c |
$done1->up;
|
|
Packit |
b3426c |
$exit1->down;
|
|
Packit |
b3426c |
});
|
|
Packit |
b3426c |
$done1->down;
|
|
Packit |
b3426c |
ok $ok1;
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
my $ok2 :shared;
|
|
Packit |
b3426c |
my $thread2 = threads->create(sub {
|
|
Packit |
b3426c |
my $ok = 1;
|
|
Packit |
b3426c |
require Devel::CallChecker;
|
|
Packit |
b3426c |
require t::LoadXS;
|
|
Packit |
b3426c |
require t::WriteHeader;
|
|
Packit |
b3426c |
t::WriteHeader::write_header("callchecker0", "t", "threads2");
|
|
Packit |
b3426c |
t::LoadXS::load_xs("threads2", "t",
|
|
Packit |
b3426c |
[Devel::CallChecker::callchecker_linkable()]);
|
|
Packit |
b3426c |
eval(q{nsub(@three)}) == 3 or $ok = 0;
|
|
Packit |
b3426c |
eval(q{tsub2(@three)}) == 3 or $ok = 0;
|
|
Packit |
b3426c |
t::threads2::cv_set_call_checker_proto(\&tsub2, "\$");
|
|
Packit |
b3426c |
eval(q{nsub(@three)}) == 3 or $ok = 0;
|
|
Packit |
b3426c |
eval(q{tsub2(@three)}) == 1 or $ok = 0;
|
|
Packit |
b3426c |
$ok2 = $ok;
|
|
Packit |
b3426c |
$done2->up;
|
|
Packit |
b3426c |
$exit2->down;
|
|
Packit |
b3426c |
});
|
|
Packit |
b3426c |
$done2->down;
|
|
Packit |
b3426c |
ok $ok2;
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
$exit1->up;
|
|
Packit |
b3426c |
$exit2->up;
|
|
Packit |
b3426c |
$thread1->join;
|
|
Packit |
b3426c |
$thread2->join;
|
|
Packit |
b3426c |
ok 1;
|
|
Packit |
b3426c |
|
|
Packit |
b3426c |
1;
|