Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
basic.t	3.9 KB	-r--r--r--	2014-12-27 11:48
blocks.t	2.21 KB	-r--r--r--	2014-12-27 11:48
context.t	3.47 KB	-r--r--r--	2014-12-27 11:48
end.t	1.32 KB	-r--r--r--	2014-12-27 11:48
err.t	1.53 KB	-r--r--r--	2014-12-27 11:49
exit.t	4.62 KB	-r--r--r--	2014-12-27 11:49
free.t	3.87 KB	-r--r--r--	2014-12-27 11:48
free2.t	5.74 KB	-r--r--r--	2014-12-27 11:48
join.t	5.27 KB	-r--r--r--	2014-12-27 11:48
kill.t	3.47 KB	-r--r--r--	2014-12-27 11:48
kill2.t	2.36 KB	-r--r--r--	2014-12-27 11:48
libc.t	1016 B	-r--r--r--	2014-12-27 11:48
list.t	1.79 KB	-r--r--r--	2014-12-27 11:48
no_threads.t	692 B	-r--r--r--	2014-12-27 11:48
problems.t	4.61 KB	-r--r--r--	2014-12-27 11:48
stack.t	2.63 KB	-r--r--r--	2014-12-27 11:48
stack_env.t	964 B	-r--r--r--	2014-12-27 11:48
state.t	6.53 KB	-r--r--r--	2014-12-27 11:48
stress_cv.t	1.04 KB	-r--r--r--	2014-12-27 11:48
stress_re.t	1.15 KB	-r--r--r--	2014-12-27 11:48
stress_string.t	1.03 KB	-r--r--r--	2014-12-27 11:48
thread.t	7.11 KB	-r--r--r--	2014-12-27 11:49

Rename

use strict;
use warnings;

BEGIN {
    require($ENV{PERL_CORE} ? '../../t/test.pl' : './t/test.pl');

use Config;
    if (! $Config{'useithreads'}) {
        skip_all(q/Perl not compiled with 'useithreads'/);
    }
}

use ExtUtils::testlib;

use threads;

BEGIN {
    if (! eval 'use threads::shared; 1') {
        skip_all('threads::shared not available');
    }

local $SIG{'HUP'} = sub {};
    my $thr = threads->create(sub {});
    eval { $thr->kill('HUP') };
    $thr->join();
    if ($@ && $@ =~ /safe signals/) {
        skip_all('Not using safe signals');
    }

plan(4);
};

fresh_perl_is(<<'EOI', 'ok', { }, 'No signal handler in thread');
    use threads;
    use Thread::Semaphore;
    my $sema = Thread::Semaphore->new(0);
    my $test = sub {
        my $sema = shift;
        $sema->up();
        while(1) { sleep(1); }
    };
    my $thr = threads->create($test, $sema);
    $sema->down();
    $thr->detach();
    eval {
        $thr->kill('STOP');
    };
    print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok');
EOI

fresh_perl_is(<<'EOI', 'ok', { }, 'Handler to signal mismatch');
    use threads;
    use Thread::Semaphore;
    my $sema = Thread::Semaphore->new(0);
    my $test = sub {
        my $sema = shift;
        $SIG{'TERM'} = sub { threads->exit() };
        $sema->up();
        while(1) { sleep(1); }
    };
    my $thr = threads->create($test, $sema);
    $sema->down();
    $thr->detach();
    eval {
        $thr->kill('STOP');
    };
    print(($@ =~ /no signal handler set/) ? 'ok' : 'not ok');
EOI

fresh_perl_is(<<'EOI', 'ok', { }, 'Handler and signal match');
    use threads;
    use Thread::Semaphore;
    my $sema = Thread::Semaphore->new(0);
    my $test = sub {
        my $sema = shift;
        $SIG{'STOP'} = sub { threads->exit() };
        $sema->up();
        while(1) { sleep(1); }
    };
    my $thr = threads->create($test, $sema);
    $sema->down();
    $thr->detach();
    eval {
        $thr->kill('STOP');
    };
    print((! $@) ? 'ok' : 'not ok');
EOI

fresh_perl_is(<<'EOI', 'ok', { }, 'Ignore signal after thread finishes');
    use threads;

my $thr = threads->create(sub {
        $SIG{KILL} = sub {
            threads->exit();
        };
        return 0;
    });

until ($thr->is_joinable()) {
        threads->yield();
    }

$thr->kill('SIGKILL');
    $thr->join();
    print((! $@) ? 'ok' : 'not ok');
EOI

exit(0);

# EOF