view release on metacpan or  search on metacpan

omnithreads/t/kill.t  view on Meta::CPAN

        exit(0);
    }

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

{
    package Thread::Semaphore;
    use omnithreads::shared;

    sub new {
        my $class = shift;
        my $val : shared = @_ ? shift : 1;
        bless \$val, $class;
    }

    sub down {
        my $s = shift;
        lock($$s);
        my $inc = @_ ? shift : 1;
        cond_wait $$s until $$s >= $inc;
        $$s -= $inc;
    }

    sub up {
        my $s = shift;
        lock($$s);
        my $inc = @_ ? shift : 1;
        ($$s += $inc) > 0 and cond_broadcast $$s;
    }
}

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

my $TEST = 1;
share($TEST);

ok(1, 'Loaded');

sub ok {
    my ($ok, $name) = @_;

    lock($TEST);
    my $id = $TEST++;

    # You have to do it this way or VMS will get confused.
    if ($ok) {
        print("ok $id - $name\n");
    } else {
        print("not ok $id - $name\n");
        printf("# Failed test at line %d\n", (caller)[2]);
    }

    return ($ok);
}


### Start of Testing ###

### Thread cancel ###

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


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

    # Thread sleeps until signalled
    ok(1, 'Thread sleeping');
    {
        local $SIG{'INT'} = sub {};
        sleep(5);
    }
    # Should not go past here
    ok(0, 'Thread terminated normally');
    return ('ERROR');
}


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

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

# Interrupt thread's sleep call
if (0) {
    # We can't be sure whether the signal itself will get delivered to this
    # thread or the sleeping thread
    local $SIG{'INT'} = sub {};
    ok(kill('INT', $$) || $^O eq 'MSWin32', q/Interrupt thread's sleep call/);
}

# 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');