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