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