actually add the test code
[poe-xs-queue-array.git] / t / 02_release.t
CommitLineData
c50a32c9
TC
1#!perl -w
2# checks we're handling references correctly in XS
3# or tries to
4use strict;
5
6use Test::More tests => 37;
7
8my $counter = 'AA';
9
10BEGIN { use_ok("POE::XS::Queue::Array") }
11
12my %released;
13
14my ($obj, $value) = Counter->new;
15
16my $q = POE::XS::Queue::Array->new;
17
18print "# trivial one item and dequeue it\n";
19$q->enqueue(100, $obj);
20undef $obj;
21ok(!$released{$value}, "check it's not released too early");
22$q->dequeue_next; # important we discard this
23ok($released{$value}, "or too late in void context dequeue");
24
25%released = ();
26($obj, $value) = Counter->new;
27# do it in list context
28$q->enqueue(101, $obj);
29undef $obj;
30ok(!$released{$value}, "check early release for list dequeue");
31my @res = $q->dequeue_next;
32ok(!$released{$value}, "check early release for list dequeue (in array)");
33undef @res;
34ok($released{$value} == 1, "should be free now");
35is(keys %released, 1, "check only one released");
36
37print "# remove single item - item at the front - void context\n";
38%released = ();
39($obj, $value) = Counter->new;
40my ($obj2, $value2) = Counter->new;
41my $id = $q->enqueue(102, $obj);
42my $id2 = $q->enqueue(103, $obj2);
43undef $obj;
44undef $obj2;
45ok(!$released{$value}, "check neither ...");
46ok(!$released{$value2}, "... has been released");
47$q->remove_item($id, sub { 1 });
48ok($released{$value}, "check it's released");
49ok(!$released{$value2}, "and other isn't");
50is(keys %released, 1, "check only one released");
51is($q->get_item_count, 1, "check count");
52
53print "# remove single item - item at the front - list context\n";
54%released = ();
55($obj, $value) = Counter->new;
56#my ($obj2, $value2) = Counter->new; # already in the queue
57$id = $q->enqueue(102, $obj);
58# my $id2 = $q->enqueue(103, $obj2); already in the queue
59undef $obj;
60# undef $obj2; done already
61ok(!$released{$value}, "check neither ...");
62ok(!$released{$value2}, "... has been released");
63@res = $q->remove_item($id, sub { 1 });
64undef @res;
65ok($released{$value}, "check it's released");
66ok(!$released{$value2}, "and other isn't");
67is(keys %released, 1, "check only one released");
68
69# list/void context doesn't matter here - it's handled in the XS code and
70# is tested above
71print "# remove single item - item at the end\n";
72%released = ();
73($obj, $value) = Counter->new;
74$id = $q->enqueue(104, $obj);
75undef $obj;
76ok(!$released{$value}, "check not released yet");
77$q->remove_item($id, sub { 1 });
78ok($released{$value}, "check it was released");
79ok(!$released{$value2}, "and other isn't");
80is(keys %released, 1, "check only one released");
81
82print "# remove single item - item in the middle\n";
83%released = ();
84($obj, $value) = Counter->new;
85my ($obj3, $value3) = Counter->new;
86$id = $q->enqueue(102, $obj);
87my $id3 = $q->enqueue(104, $obj3);
88undef $obj;
89undef $obj3;
90$q->remove_item($id2, sub { 1 });
91ok($released{$value2}, "check it was released");
92ok(!$released{$value}, "and others ...");
93ok(!$released{$value3}, "... weren't");
94
95print "# peek at the contents\n";
96%released = ();
97@res = $q->peek_items(sub { 1 });
98is(keys %released, 0, "check nothing released");
99undef @res;
100is(keys %released, 0, "still nothing released");
101$q->remove_item($id, sub { 1 });
102ok($released{$value}, "check one released");
103$q->remove_item($id3, sub { 1 });
104ok($released{$value3}, "check other released");
105is(keys %released, 2, "check nothing else released");
106
107print "# bulk removal\n";
108%released = ();
109($obj, $value) = Counter->new;
110($obj2, $value2) = Counter->new;
111($obj3, $value3) = Counter->new;
112$q->enqueue(101, $obj);
113$q->enqueue(103, $obj2);
114$q->enqueue(102, $obj3);
115undef $obj;
116undef $obj2;
117undef $obj3;
118@res = $q->remove_items(sub { ${$_[0]} eq $value3 });
119is(keys %released, 0, "nothing released yet");
120undef @res;
121ok($released{$value3}, "check it was released");
122is(keys %released, 1, "and nothing else");
123# remove the rest
124$q->remove_items(sub { 1 });
125ok($released{$value}, "check both ...");
126ok($released{$value2}, "... have been released");
127is(keys %released, 3, "and nothing else");
128is($q->get_item_count, 0, "and queue is empty");
129
130# priority adjustments
131%released = ();
132($obj, $value) = Counter->new;
133($obj2, $value2) = Counter->new;
134($obj3, $value3) = Counter->new;
135$q->enqueue(101, $obj);
136$q->enqueue(102, $obj2);
137$q->enqueue(103, $obj3);
138undef $obj;
139undef $obj2;
140undef $obj3;
141
142
143# test class used to track destruction
144sub Counter::new {
145 my $foo = $counter++;
146 print "# created $foo\n";
147 if (wantarray) {
148 return ( (bless \$foo, shift), $foo );
149 }
150 else {
151 return bless \$foo, shift;
152 }
153}
154
155sub Counter::value { ${$_[0]} }
156
157sub Counter::DESTROY {
158 print "# destroyed ${$_[0]}\n";
159 ++$released{${$_[0]}}
160}