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 | ||
15 | if ($] == 5.008) { | |
16 | require 't/test.pl'; # Test::More work-alike for Perl 5.8.0 | |
17 | } else { | |
18 | require Test::More; | |
19 | } | |
20 | Test::More->import(); | |
21 | plan('tests' => 20); | |
22 | ||
23 | my $q = Thread::Queue->new(1..10); | |
24 | ok($q, 'New queue'); | |
25 | ||
26 | threads->create(sub { | |
27 | # Default count = 1 | |
28 | is($q->extract(), 1, 'No args'); # 2..10 left | |
29 | is($q->extract(0), 2, 'Head'); # 3..10 left | |
30 | is($q->extract(5), 8, 'Pos index'); # 3..7,9,10 left | |
31 | is($q->extract(-3), 7, 'Neg index'); # 3..6,9,10 left | |
32 | my $x = $q->extract(20); # unchanged | |
33 | ok(! defined($x), 'Big index'); | |
34 | $x = $q->extract(-20); # unchanged | |
35 | ok(! defined($x), 'Big neg index'); | |
36 | })->join(); | |
37 | ||
38 | $q = Thread::Queue->new(1..10); | |
39 | ok($q, 'New queue'); | |
40 | ||
41 | threads->create(sub { | |
42 | my @x = $q->extract(0, 2); # 3..10 left | |
43 | is_deeply(\@x, [1,2], '2 from head'); | |
44 | @x = $q->extract(6, 2); # 3..8 left | |
45 | is_deeply(\@x, [9,10], '2 from tail'); | |
46 | @x = $q->extract(2, 2); # 3,4,7,8 left | |
47 | is_deeply(\@x, [5,6], '2 from middle'); | |
48 | @x = $q->extract(2, 4); # 3,4 left | |
49 | is_deeply(\@x, [7,8], 'Lots from tail'); | |
50 | @x = $q->extract(3, 4); # unchanged | |
51 | is_deeply(\@x, [], 'Too far'); | |
52 | })->join(); | |
53 | ||
54 | $q = Thread::Queue->new(1..10); | |
55 | ok($q, 'New queue'); | |
56 | ||
57 | threads->create(sub { | |
58 | my @x = $q->extract(-4, 2); # 1..6,9,10 left | |
59 | is_deeply(\@x, [7,8], 'Neg index'); | |
60 | @x = $q->extract(-2, 4); # 1..6 left | |
61 | is_deeply(\@x, [9,10], 'Lots from tail'); | |
62 | @x = $q->extract(-6, 2); # 3..6 left | |
63 | is_deeply(\@x, [1,2], 'Max neg index'); | |
64 | @x = $q->extract(-10, 3); # unchanged | |
65 | is_deeply(\@x, [], 'Too far'); | |
66 | @x = $q->extract(-6, 3); # 4..6 left | |
67 | is_deeply(\@x, [3], 'Neg overlap'); | |
68 | @x = $q->extract(-5, 10); # empty | |
69 | is_deeply(\@x, [4..6], 'Neg big overlap'); | |
70 | })->join(); | |
71 | ||
3d4f2f89 JH |
72 | exit(0); |
73 | ||
54c7876f | 74 | # EOF |