BEGIN {
if
(!
$Config
{
'useithreads'
}) {
print
(
"1..0 # Skip: Perl not compiled with 'useithreads'\n"
);
exit
(0);
}
if
(
defined
$Devel::Cover::VERSION
) {
print
(
"1..0 # Skip: Devel::Cover no like ithreads\n"
);
exit
(0);
}
}
my
$N_threads
= 5;
my
@data_is_correct
: shared;
my
@could_get_data
: shared;
my
@bad_is_correct
: shared;
parallelize {
my
$pid
= parallel_id;
my
$pdl
= ones(10) *
$pid
;
$pdl
->share_as(
"data$pid"
);
my
$bad
= ones(cfloat, 5);
$bad
->badvalue(17);
$bad
->setbadat(2);
$bad
->share_as(
"bad$pid"
);
my
$thread_to_grab
=
$pid
- 1;
$thread_to_grab
=
$N_threads
- 1
if
$pid
== 0;
parallel_sync;
eval
{
my
$to_test
= retrieve_pdls(
"data$thread_to_grab"
);
$could_get_data
[
$pid
] = 1;
$data_is_correct
[
$pid
] = all(
$to_test
==
$thread_to_grab
)->sclr
or diag(
"For thread $pid, expected ${thread_to_grab}s but got $to_test"
);
$to_test
= retrieve_pdls(
"bad$thread_to_grab"
);
my
$isbad
=
$to_test
->isbad;
$bad_is_correct
[
$pid
] = all(
$isbad
== pdl(0,0,1,0,0))->sclr || diag
"got=$isbad\nto_test=$to_test"
;
1;
} or
do
{
diag(
"data pull for pid $pid failed: $@"
);
$could_get_data
[
$pid
] = 0;
$data_is_correct
[
$pid
] = 0;
$bad_is_correct
[
$pid
] = 0;
};
}
$N_threads
;
my
@expected
= (1) x
$N_threads
;
is_deeply(\
@could_get_data
, \
@expected
,
'Threads could access data created by sibling threads'
)
or diag(
"expected all 1s, actually got @could_get_data"
);
is_deeply(\
@data_is_correct
, \
@expected
,
'Data created by sibling threads worked correctly'
)
or diag(
"expected all 1s, actually got @data_is_correct"
);
is_deeply(\
@bad_is_correct
, \
@expected
,
'Data created by sibling threads badflags survived correctly'
)
or diag(
"expected all 1s, actually got @data_is_correct"
);
for
(1..
$N_threads
-1) {
throws_ok {
retrieve_pdls(
"data$_"
)
}
qr/was created in a thread that has ended or is detached/
,
"Retrieving shared data created by already-terminated thread $_ croaks"
;
}
done_testing();