0.006 release
[poe-xs-queue-array.git] / t / 01_array.t
CommitLineData
e38f8ec4
TC
1#!/usr/bin/perl -w
2# $Id: 01_array.t,v 1.1 2004/09/04 22:50:38 rcaputo Exp $
3
4# Tests basic queue operations.
5# copied from the POE distribution and modified to use
6# POE::XS::Queue::Array instead of POE::Queue::Array.
7#
8# modified a couple of tests to use is_deeply() instead of ok(eq_array ...)
9# during debugging.
10
11use strict;
12
13use lib qw(./mylib);
14
a603f2ce 15use Test::More tests => 2048;
e38f8ec4
TC
16
17sub POE::Kernel::ASSERT_DEFAULT () { 1 }
18sub POE::Kernel::TRACE_DEFAULT () { 1 }
19sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" }
20
21use POSIX qw(EPERM ESRCH);
22
23BEGIN { use_ok("POE::XS::Queue::Array") }
24
25my $q = POE::XS::Queue::Array->new();
26
a603f2ce
TC
27isa_ok($q, 'POE::Queue');
28
e38f8ec4
TC
29ok($q->get_item_count == 0, "queue begins empty");
30ok(!defined($q->dequeue_next), "can't dequeue from empty queue");
31
32ok($q->enqueue(1, "one") == 1, "first enqueue has id 1");
33ok($q->enqueue(3, "tre") == 2, "second enqueue has id 2");
34ok($q->enqueue(2, "two") == 3, "third enqueue has id 3");
35
36is_deeply(
37 [$q->dequeue_next()], [1, 1, "one"],
38 "event one dequeued correctly"
39);
40
41is_deeply(
42 [$q->dequeue_next()], [2, 3, "two"],
43 "event two dequeued correctly"
44);
45
46ok(
47 eq_array( [$q->dequeue_next()], [3, 2, "tre"] ),
48 "event three dequeued correctly"
49);
50
51ok(
52 eq_array( [$q->dequeue_next()], [] ),
53 "empty queue marker dequeued correctly"
54);
55
56{ my @events = (
57 [ a => 1 ],
58 [ c => 3 ],
59 [ e => 5 ],
60 [ b => 2 ],
61 [ d => 4 ],
62 );
63
64 my $base_event_id = 4;
65 enqueue_events(\@events, $base_event_id);
66}
67
68# Not constants.
69sub always_ok { 1 }
70sub never_ok { 0 }
71
72ok(
73 eq_array( [$q->remove_item(7, \&always_ok)], [2, 7, "b"] ),
74 "removed event b by its ID"
75);
76
77ok(
78 eq_array( [$q->remove_item(5, \&always_ok)], [3, 5, "c"] ),
79 "removed event c by its ID"
80);
81
82ok(
83 eq_array( [$q->remove_item(8, \&always_ok)], [4, 8, "d"] ),
84 "removed event d by its ID"
85);
86
87$! = 0;
88ok(
89 ( eq_array( [$q->remove_item(6, \&never_ok )], [] ) &&
90 $! == EPERM
91 ),
92 "didn't have permission to remove event e"
93);
94
95$! = 0;
96ok(
97 ( eq_array( [$q->remove_item(8, \&always_ok)], [] ) &&
98 $! == ESRCH
99 ),
100 "couldn't remove nonexistent event d"
101);
102
103ok(
104 eq_array( [$q->dequeue_next()], [1, 4, "a"] ),
105 "dequeued event a correctly"
106);
107
108ok(
109 eq_array( [$q->dequeue_next()], [5, 6, "e"] ),
110 "dequeued event e correctly"
111);
112
113ok(
114 eq_array( [$q->dequeue_next()], [] ),
115 "empty queue marker dequeued correctly"
116);
117
118{ my @events = (
119 [ a => 1 ],
120 [ c => 3 ],
121 [ e => 5 ],
122 [ b => 2 ],
123 [ d => 4 ],
124 [ f => 6 ],
125 );
126
127 my $base_event_id = 9;
128 enqueue_events(\@events, $base_event_id);
129}
130
131ok($q->get_item_count() == 6, "queue contains six events");
132
133sub odd_letters { $_[0] =~ /[ace]/ }
134sub even_letters { $_[0] =~ /[bdf]/ }
135
136{ my @items = $q->remove_items(\&odd_letters, 3);
137 my @target = (
138 [ 1, 9, "a" ],
139 [ 3, 10, "c" ],
140 [ 5, 11, "e" ],
141 );
142
143 ok(eq_array(\@items, \@target), "removed odd letters from queue");
144 ok($q->get_item_count() == 3, "leaving three events");
145}
146
147{ my @items = $q->remove_items(\&odd_letters, 3);
148 my @target;
149
150 ok(eq_array(\@items, \@target), "no more odd letters to remove");
151}
152
153{ my @items = $q->remove_items(\&even_letters, 3);
154 my @target = (
155 [ 2, 12, "b" ],
156 [ 4, 13, "d" ],
157 [ 6, 14, "f" ],
158 );
159
160 is_deeply(\@items, \@target, "removed even letters from queue");
161 ok($q->get_item_count() == 0, "leaving the queue empty");
162}
163
164{ my @events = (
165 [ a => 10 ],
166 [ b => 20 ],
167 [ c => 30 ],
168 [ d => 40 ],
169 [ e => 50 ],
170 [ f => 60 ],
171 );
172
173 my $base_event_id = 15;
174 enqueue_events(\@events, $base_event_id);
175}
176
177ok($q->get_item_count() == 6, "leaving six events in the queue");
178
179{ my @items = $q->peek_items(\&even_letters);
180 my @target = (
181 [ 20, 16, "b" ],
182 [ 40, 18, "d" ],
183 [ 60, 20, "f" ],
184 );
185
186 ok(eq_array(\@items, \@target), "found even letters in queue");
187}
188
189ok(
190 $q->adjust_priority(19, \&always_ok, -15) == 35,
191 "adjusted event e priority by -15"
192);
193
194ok(
195 $q->adjust_priority(16, \&always_ok, +15) == 35,
196 "adjusted event b priority by +15"
197);
198
199{ my @items = $q->remove_items(\&always_ok);
200 my @target = (
201 [ 10, 15, "a" ],
202 [ 30, 17, "c" ],
203 [ 35, 19, "e" ], # e got there first
204 [ 35, 16, "b" ], # b got there second
205 [ 40, 18, "d" ],
206 [ 60, 20, "f" ],
207 );
208
209 ok(eq_array(\@items, \@target), "colliding priorities are FIFO");
210}
211
212ok($q->get_item_count() == 0, "full queue removal leaves zero events");
213
214### Large Queue Tests. The only functions that use large queues are
215### enqueue(), adjust_priority(), and set_priority(). Large queues
216### are over ~500 elements.
217
218# Generate a list of events in random priority order.
219
220sub shuffled_list {
221 my $limit = shift() - 1;
222 my @list = (0..$limit);
223 my $i = @list;
224 while (--$i) {
225 my $j = int rand($i+1);
226 @list[$i,$j] = @list[$j,$i];
227 }
228 @list;
229}
230
231sub is_even { !($_[0] % 2) }
232sub is_odd { $_[0] % 2 }
233
234sub verify_queue {
235 my $target_diff = shift;
236
237 my $low_priority = -999999;
238
239 while (my ($pri, $id, $item) = $q->dequeue_next()) {
240 my $diff;
241 if ($pri < 0) {
242 $diff = $item - $pri;
243 }
244 else {
245 $diff = $pri - $item;
246 }
247
248 ok(
249 ($pri > $low_priority) && ($diff == $target_diff),
250 "$item - $pri == $diff (should be $target_diff)"
251 );
252
253 $low_priority = $pri;
254 }
255}
256
257# Enqueue all the events, then adjust their priorities. The
258# even-numbered events have their priorities reduced by 1000; the odd
259# ones have their priorities increased by 1000.
260
261{ my @ids;
262 for my $major (shuffled_list(10)) {
263 for my $minor (shuffled_list(100)) {
264 my $priority = sprintf("%2d%02d", $major, $minor);
265 push @ids, $q->enqueue($priority, $priority);
266 }
267 }
268
269 foreach my $id (@ids) { $q->adjust_priority($id, \&is_even, -1000); }
270 foreach my $id (@ids) { $q->adjust_priority($id, \&is_odd, 1000); }
271}
272
273# Verify that the queue remains in order, and that the adjusted
274# priorities are correct.
275
276print "!!!!!!!! 1\n";
277verify_queue(1000);
278
279# Now set priorities to absolute values. The values are
280
281{ my @id_recs;
282 for my $major (shuffled_list(10)) {
283 for my $minor (shuffled_list(100)) {
284 my $priority = sprintf("%2d%02d", $major, $minor);
285 push @id_recs, [ $q->enqueue($priority, $priority), $priority ];
286 }
287 }
288
289 foreach my $id_rec (@id_recs) {
290 my ($id, $pri) = @$id_rec;
291 $q->set_priority($id, \&is_even, $pri + 500);
292 }
293
294 foreach my $id_rec (@id_recs) {
295 my ($id, $pri) = @$id_rec;
296 $q->set_priority($id, \&is_odd, $pri + 500);
297 }
298
299 verify_queue(500);
300}
301
302### Helper functions.
303
304sub enqueue_events {
305 my ($events, $id) = @_;
306 foreach (@$events) {
307 my ($ev, $prio) = @$_;
308 ok($q->enqueue($prio, $ev) == $id++, "enqueued event $ev correctly");
309 }
310}