0.006 release
[poe-xs-queue-array.git] / t / 01_array.t
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
11 use strict;
12
13 use lib qw(./mylib);
14
15 use Test::More tests => 2048;
16
17 sub POE::Kernel::ASSERT_DEFAULT () { 1 }
18 sub POE::Kernel::TRACE_DEFAULT  () { 1 }
19 sub POE::Kernel::TRACE_FILENAME () { "./test-output.err" }
20
21 use POSIX qw(EPERM ESRCH);
22
23 BEGIN { use_ok("POE::XS::Queue::Array") }
24
25 my $q = POE::XS::Queue::Array->new();
26
27 isa_ok($q, 'POE::Queue');
28
29 ok($q->get_item_count == 0, "queue begins empty");
30 ok(!defined($q->dequeue_next), "can't dequeue from empty queue");
31
32 ok($q->enqueue(1, "one") == 1, "first enqueue has id 1");
33 ok($q->enqueue(3, "tre") == 2, "second enqueue has id 2");
34 ok($q->enqueue(2, "two") == 3, "third enqueue has id 3");
35
36 is_deeply(
37   [$q->dequeue_next()], [1, 1, "one"],
38   "event one dequeued correctly"
39 );
40
41 is_deeply(
42   [$q->dequeue_next()], [2, 3, "two"],
43   "event two dequeued correctly"
44 );
45
46 ok(
47   eq_array( [$q->dequeue_next()], [3, 2, "tre"] ),
48   "event three dequeued correctly"
49 );
50
51 ok(
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.
69 sub always_ok { 1 }
70 sub never_ok  { 0 }
71
72 ok(
73   eq_array( [$q->remove_item(7, \&always_ok)], [2, 7, "b"] ),
74   "removed event b by its ID"
75 );
76
77 ok(
78   eq_array( [$q->remove_item(5, \&always_ok)], [3, 5, "c"] ),
79   "removed event c by its ID"
80 );
81
82 ok(
83   eq_array( [$q->remove_item(8, \&always_ok)], [4, 8, "d"] ),
84   "removed event d by its ID"
85 );
86
87 $! = 0;
88 ok(
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;
96 ok(
97   ( eq_array( [$q->remove_item(8, \&always_ok)], [] ) &&
98     $! == ESRCH
99   ),
100   "couldn't remove nonexistent event d"
101 );
102
103 ok(
104   eq_array( [$q->dequeue_next()], [1, 4, "a"] ),
105   "dequeued event a correctly"
106 );
107
108 ok(
109   eq_array( [$q->dequeue_next()], [5, 6, "e"] ),
110   "dequeued event e correctly"
111 );
112
113 ok(
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
131 ok($q->get_item_count() == 6, "queue contains six events");
132
133 sub odd_letters  { $_[0] =~ /[ace]/ }
134 sub 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
177 ok($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
189 ok(
190   $q->adjust_priority(19, \&always_ok, -15) == 35,
191   "adjusted event e priority by -15"
192 );
193
194 ok(
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
212 ok($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
220 sub 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
231 sub is_even { !($_[0] % 2) }
232 sub is_odd  {   $_[0] % 2  }
233
234 sub 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
276 print "!!!!!!!! 1\n";
277 verify_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
304 sub 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 }