0.006 release
[poe-xs-queue-array.git] / t / 02_release.t
1 #!perl -w
2 # checks we're handling references correctly in XS
3 # or tries to
4 use strict;
5
6 use Test::More tests => 37;
7
8 my $counter = 'AA';
9
10 BEGIN { use_ok("POE::XS::Queue::Array") }
11
12 my %released;
13
14 my ($obj, $value) = Counter->new;
15
16 my $q = POE::XS::Queue::Array->new;
17
18 print "# trivial one item and dequeue it\n";
19 $q->enqueue(100, $obj);
20 undef $obj;
21 ok(!$released{$value}, "check it's not released too early");
22 $q->dequeue_next; # important we discard this
23 ok($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);
29 undef $obj;
30 ok(!$released{$value}, "check early release for list dequeue");
31 my @res = $q->dequeue_next;
32 ok(!$released{$value}, "check early release for list dequeue (in array)");
33 undef @res;
34 ok($released{$value} == 1, "should be free now");
35 is(keys %released, 1, "check only one released");
36
37 print "# remove single item - item at the front - void context\n";
38 %released = ();
39 ($obj, $value) = Counter->new;
40 my ($obj2, $value2) = Counter->new;
41 my $id = $q->enqueue(102, $obj);
42 my $id2 = $q->enqueue(103, $obj2);
43 undef $obj;
44 undef $obj2;
45 ok(!$released{$value}, "check neither ...");
46 ok(!$released{$value2}, "... has been released");
47 $q->remove_item($id, sub { 1 });
48 ok($released{$value}, "check it's released");
49 ok(!$released{$value2}, "and other isn't");
50 is(keys %released, 1, "check only one released");
51 is($q->get_item_count, 1, "check count");
52
53 print "# 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
59 undef $obj;
60 # undef $obj2; done already
61 ok(!$released{$value}, "check neither ...");
62 ok(!$released{$value2}, "... has been released");
63 @res = $q->remove_item($id, sub { 1 });
64 undef @res;
65 ok($released{$value}, "check it's released");
66 ok(!$released{$value2}, "and other isn't");
67 is(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
71 print "# remove single item - item at the end\n";
72 %released = ();
73 ($obj, $value) = Counter->new;
74 $id = $q->enqueue(104, $obj);
75 undef $obj;
76 ok(!$released{$value}, "check not released yet");
77 $q->remove_item($id, sub { 1 });
78 ok($released{$value}, "check it was released");
79 ok(!$released{$value2}, "and other isn't");
80 is(keys %released, 1, "check only one released");
81
82 print "# remove single item - item in the middle\n";
83 %released = ();
84 ($obj, $value) = Counter->new;
85 my ($obj3, $value3) = Counter->new;
86 $id = $q->enqueue(102, $obj);
87 my $id3 = $q->enqueue(104, $obj3);
88 undef $obj;
89 undef $obj3;
90 $q->remove_item($id2, sub { 1 });
91 ok($released{$value2}, "check it was released");
92 ok(!$released{$value}, "and others ...");
93 ok(!$released{$value3}, "... weren't");
94
95 print "# peek at the contents\n";
96 %released = ();
97 @res = $q->peek_items(sub { 1 });
98 is(keys %released, 0, "check nothing released");
99 undef @res;
100 is(keys %released, 0, "still nothing released");
101 $q->remove_item($id, sub { 1 });
102 ok($released{$value}, "check one released");
103 $q->remove_item($id3, sub { 1 });
104 ok($released{$value3}, "check other released");
105 is(keys %released, 2, "check nothing else released");
106
107 print "# 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);
115 undef $obj;
116 undef $obj2;
117 undef $obj3;
118 @res = $q->remove_items(sub { ${$_[0]} eq $value3 });
119 is(keys %released, 0, "nothing released yet");
120 undef @res;
121 ok($released{$value3}, "check it was released");
122 is(keys %released, 1, "and nothing else");
123 # remove the rest
124 $q->remove_items(sub { 1 });
125 ok($released{$value}, "check both ...");
126 ok($released{$value2}, "... have been released");
127 is(keys %released, 3, "and nothing else");
128 is($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);
138 undef $obj;
139 undef $obj2;
140 undef $obj3;
141
142
143 # test class used to track destruction
144 sub 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
155 sub Counter::value { ${$_[0]} }
156
157 sub Counter::DESTROY { 
158   print "# destroyed ${$_[0]}\n";
159   ++$released{${$_[0]}}
160 }