1use strict;
2use warnings;
3
4BEGIN {
5    use Config;
6    if (! $Config{'useithreads'}) {
7        print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
8        exit(0);
9    }
10}
11
12use threads;
13use Thread::Queue;
14use Thread::Semaphore;
15
16BEGIN { # perl RT 133382
17if ($] == 5.008) {
18    require 't/test.pl';   # Test::More work-alike for Perl 5.8.0
19} else {
20    require Test::More;
21}
22Test::More->import();
23} # end BEGIN
24plan('tests' => 3);
25
26# The following tests locking a queue
27
28my $q = Thread::Queue->new(1..10);
29ok($q, 'New queue');
30
31my $sm = Thread::Semaphore->new(0);
32my $st = Thread::Semaphore->new(0);
33
34my $thr = threads->create(sub {
35    {
36        lock($q);
37        $sm->up();
38        $st->down();
39        threads::yield();
40        select(undef, undef, undef, 0.1);
41        my @x = $q->extract(5,2);
42        is_deeply(\@x, [6,7], 'Thread dequeues under lock');
43    }
44});
45
46$sm->down();
47$st->up();
48my @x = $q->dequeue_nb(100);
49is_deeply(\@x, [1..5,8..10], 'Main dequeues');
50
51$thr->join();
52
53exit(0);
54
55# EOF
56