#!perl -T
BEGIN {
plan
skip_all
=>
'ithreads required'
unless
$Config
{useithreads};
eval
'use threads'
;
plan
skip_all
=>
'threads.pm required'
if
$@;
plan
tests
=> 12;
}
my
$badthread
= threads->create(\
&thread_try_to_cause_problems
);
{
$! = 99_999_971;
select
undef
,
undef
,
undef
, .3;
is 0+$!, 99_999_971,
"per-thread errno"
;
$! = custom_errstr
"test message"
;
select
undef
,
undef
,
undef
, .3;
is 0+$!, CUSTOM_ERRSTR_ERRNO,
"per-thread errno"
;
is
"$!"
,
"test message"
,
"per-thread custom errstr"
;
my
$saved_errno
= $!;
$! = 1235;
$! = custom_errstr
"aksjfdhakdsfh"
;
$! =
$saved_errno
;
select
undef
,
undef
,
undef
, .3;
is
"$!"
,
"test message"
,
"custom errstr restore theadsafe"
;
$! = register_errstr
"reg test message"
;
select
undef
,
undef
,
undef
, .3;
is
"$!"
,
"reg test message"
,
"per-thread registered errstr"
;
my
$regsave
= 0 + $!;
$! = 1235;
$! = register_errstr
"aksjfdhakdsfh"
;
$! = register_errstr
"foo-aksjfdhakdsfh"
;
$! =
$regsave
;
select
undef
,
undef
,
undef
, .3;
is
"$!"
,
"reg test message"
,
"registered errstr restore theadsafe"
;
$! = custom_errstr
"test message 2"
;
my
$saved_errno_numeric
= 0 + $!;
$! = 1235;
select
undef
,
undef
,
undef
, .3;
$! =
$saved_errno_numeric
;
is
"$!"
,
"test message 2"
,
"custom errstr numeric restore theadsafe"
;
my
$result
= threads->create(
sub
{
$! = custom_errstr
"message from another thread"
;
return
{
Error
=> $! };
})->
join
;
is
"$result->{Error}"
,
"message from another thread"
,
"cross-thread errstr passing"
;
is 0+
$result
->{Error}, CUSTOM_ERRSTR_ERRNO,
"cross-thread errno passing"
;
my
$regresult
= threads->create(
sub
{
$! = register_errstr
"reg message from another thread"
;
return
{
Error
=> $! };
})->
join
;
is
"$regresult->{Error}"
,
"reg message from another thread"
,
"cross-thread reg errstr passing"
;
}
eval
{
$badthread
->
kill
(
'KILL'
) };
$badthread
->
join
;
sub
thread_try_to_cause_problems {
$SIG
{
'KILL'
} =
sub
{ threads->
exit
(); };
for
my
$i
(1 .. 200) {
$! = custom_errstr
"qwerty $i"
;
select
undef
,
undef
,
undef
, .01;
$! = 1234;
select
undef
,
undef
,
undef
, .01;
open
my
$fh
,
"<"
,
"/no/such/file"
;
select
undef
,
undef
,
undef
, .01;
}
}
taint_checking_ok;