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 {
    use Config;
    if (! $Config{'useithreads'}) {
        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
        exit(0);
    }
}

use ExtUtils::testlib;

use threads;

BEGIN {
    if (! eval 'use threads::shared; 1') {
        print("1..0 # SKIP threads::shared not available\n");
        exit(0);
    }

local $SIG{'HUP'} = sub {};
    my $thr = threads->create(sub {});
    eval { $thr->kill('HUP') };
    $thr->join();
    if ($@ && $@ =~ /safe signals/) {
        print("1..0 # SKIP Not using safe signals\n");
        exit(0);
    }

require Thread::Queue;
    require Thread::Semaphore;

$| = 1;
    print("1..18\n");   ### Number of tests that will be run ###
};

my $q = Thread::Queue->new();
my $TEST = 1;

sub ok
{
    $q->enqueue(@_);

while ($q->pending()) {
        my $ok   = $q->dequeue();
        my $name = $q->dequeue();
        my $id   = $TEST++;

if ($ok) {
            print("ok $id - $name\n");
        } else {
            print("not ok $id - $name\n");
            printf("# Failed test at line %d\n", (caller)[2]);
        }
    }
}

### Start of Testing ###
ok(1, 'Loaded');

### Thread cancel ###

# Set up to capture warning when thread terminates
my @errs :shared;
$SIG{__WARN__} = sub { push(@errs, @_); };

sub thr_func {
    my $q = shift;

# Thread 'cancellation' signal handler
    $SIG{'KILL'} = sub {
        $q->enqueue(1, 'Thread received signal');
        die("Thread killed\n");
    };

# Thread sleeps until signalled
    $q->enqueue(1, 'Thread sleeping');
    sleep(1) for (1..10);
    # Should not go past here
    $q->enqueue(0, 'Thread terminated normally');
    return ('ERROR');
}

# Create thread
my $thr = threads->create('thr_func', $q);
ok($thr && $thr->tid() == 2, 'Created thread');
threads->yield();
sleep(1);

# Signal thread
ok($thr->kill('KILL') == $thr, 'Signalled thread');
threads->yield();

# Cleanup
my $rc = $thr->join();
ok(! $rc, 'No thread return value');

# Check for thread termination message
ok(@errs && $errs[0] =~ /Thread killed/, 'Thread termination warning');

### Thread suspend/resume ###

sub thr_func2
{
    my $q = shift;

my $sema = shift;
    $q->enqueue($sema, 'Thread received semaphore');

# Set up the signal handler for suspension/resumption
    $SIG{'STOP'} = sub {
        $q->enqueue(1, 'Thread suspending');
        $sema->down();
        $q->enqueue(1, 'Thread resuming');
        $sema->up();
    };

# Set up the signal handler for graceful termination
    my $term = 0;
    $SIG{'TERM'} = sub {
        $q->enqueue(1, 'Thread caught termination signal');
        $term = 1;
    };

# Do work until signalled to terminate
    while (! $term) {
        sleep(1);
    }

$q->enqueue(1, 'Thread done');
    return ('OKAY');
}

# Create a semaphore for use in suspending the thread
my $sema = Thread::Semaphore->new();
ok($sema, 'Semaphore created');

# Create a thread and send it the semaphore
$thr = threads->create('thr_func2', $q, $sema);
ok($thr && $thr->tid() == 3, 'Created thread');
threads->yield();
sleep(1);

# Suspend the thread
$sema->down();
ok($thr->kill('STOP') == $thr, 'Suspended thread');

threads->yield();
sleep(1);

# Allow the thread to continue
$sema->up();

threads->yield();
sleep(1);

# Terminate the thread
ok($thr->kill('TERM') == $thr, 'Signalled thread to terminate');

$rc = $thr->join();
ok($rc eq 'OKAY', 'Thread return value');

ok($thr->kill('TERM') == $thr, 'Ignore signal to terminated thread');

exit(0);

# EOF