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