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