This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Thread::Queue 3.06
[perl5.git] / dist / Thread-Queue / t / 07_lock.t
1 use strict;
2 use warnings;
3
4 BEGIN {
5     use Config;
6     if (! $Config{'useithreads'}) {
7         print("1..0 # SKIP Perl not compiled with 'useithreads'\n");
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
50 exit(0);
51
52 # EOF