initial 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 => 2047;
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 ok($q->get_item_count == 0, "queue begins empty");
28 ok(!defined($q->dequeue_next), "can't dequeue from empty queue");
29
30 ok($q->enqueue(1, "one") == 1, "first enqueue has id 1");
31 ok($q->enqueue(3, "tre") == 2, "second enqueue has id 2");
32 ok($q->enqueue(2, "two") == 3, "third enqueue has id 3");
33
34 is_deeply(
35   [$q->dequeue_next()], [1, 1, "one"],
36   "event one dequeued correctly"
37 );
38
39 is_deeply(
40   [$q->dequeue_next()], [2, 3, "two"],
41   "event two dequeued correctly"
42 );
43
44 ok(
45   eq_array( [$q->dequeue_next()], [3, 2, "tre"] ),
46   "event three dequeued correctly"
47 );
48
49 ok(
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.
67 sub always_ok { 1 }
68 sub never_ok  { 0 }
69
70 ok(
71   eq_array( [$q->remove_item(7, \&always_ok)], [2, 7, "b"] ),
72   "removed event b by its ID"
73 );
74
75 ok(
76   eq_array( [$q->remove_item(5, \&always_ok)], [3, 5, "c"] ),
77   "removed event c by its ID"
78 );
79
80 ok(
81   eq_array( [$q->remove_item(8, \&always_ok)], [4, 8, "d"] ),
82   "removed event d by its ID"
83 );
84
85 $! = 0;
86 ok(
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;
94 ok(
95   ( eq_array( [$q->remove_item(8, \&always_ok)], [] ) &&
96     $! == ESRCH
97   ),
98   "couldn't remove nonexistent event d"
99 );
100
101 ok(
102   eq_array( [$q->dequeue_next()], [1, 4, "a"] ),
103   "dequeued event a correctly"
104 );
105
106 ok(
107   eq_array( [$q->dequeue_next()], [5, 6, "e"] ),
108   "dequeued event e correctly"
109 );
110
111 ok(
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
129 ok($q->get_item_count() == 6, "queue contains six events");
130
131 sub odd_letters  { $_[0] =~ /[ace]/ }
132 sub 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
175 ok($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
187 ok(
188   $q->adjust_priority(19, \&always_ok, -15) == 35,
189   "adjusted event e priority by -15"
190 );
191
192 ok(
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
210 ok($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
218 sub 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
229 sub is_even { !($_[0] % 2) }
230 sub is_odd  {   $_[0] % 2  }
231
232 sub 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
274 print "!!!!!!!! 1\n";
275 verify_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
302 sub 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 }