The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
# Check that Errno::AnyString does the right thing under a threaded Perl

use strict;
use warnings;

use Test::More;
BEGIN {
    use Config;
    plan skip_all => 'ithreads required' unless $Config{useithreads};

    eval 'use threads';
    plan skip_all => 'threads.pm required' if $@;

    plan tests => <<< vary!!taint ? 12 : 11 >>>;
}
use Test::NoWarnings;

use threads;
use Errno::AnyString qw/custom_errstr register_errstr CUSTOM_ERRSTR_ERRNO/;

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";
}

# Older versions of threads.pm lack kill, in which case I'll wait for
# the child to die of old age.
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;
    }
}