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