- moved the structural queue code to queue.c, Array.xs is purely an

   interface to that now.
 - replaced all the opaque memmove() calls with a call to pq_move_items()
   which does sanity checks in DEBUG code.
 - added t/02_release.t which attempts to check we're handling references
   correctly.

diff --git a/Changes b/Changes
index ace56c5cd43e5cb23ec7bebac31564e471489da7..cd613afd23ce231aba6c415e2cf228790ab8d034 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,4 +1,12 @@
 Revision history for Perl extension POE::XS::Queue::Array.
 
+0.002
+ - moved the structural queue code to queue.c, Array.xs is purely an
+   interface to that now.
+ - replaced all the opaque memmove() calls with a call to pq_move_items() 
+   which does sanity checks in DEBUG code.
+ - added t/02_release.t which attempts to check we're handling references 
+   correctly.
+
 0.001
  - initial release

diff --git a/queue.c b/queue.c
index 6ddd63f6b555ea2b23410bf4ee1cf603400568fe..09ed72e0915691b678c3defc6209a002270ed313 100644 (file)
--- a/queue.c
+++ b/queue.c
@@ -4,8 +4,10 @@
 \r
 #include "queue.h"\r
 \r
-#define DEBUG(x) x\r
-/*#define DEBUG(x)*/\r
+/*#define DEBUG(x) x*/\r
+#define DEBUG(x)\r
+#define DEBUG_ERR(x) x\r
+/*#define DEBUG_ERR(x)*/\r
 \r
 #define PQ_START_SIZE 10\r
 #define AT_START 0\r
@@ -169,6 +171,40 @@ pq_set_id_priority(poe_queue *pq, pq_id_t id, pq_priority_t new_priority) {
   sv_setnv(HeVAL(entry), new_priority);\r
 }\r
 \r
+/*\r
+pq_move_items - moves items around.\r
+\r
+This encapsulates the old calls to memmove(), providing a single place\r
+to add error checking.\r
+*/\r
+static void\r
+pq_move_items(poe_queue *pq, int target, int src, int count) {\r
+\r
+  DEBUG_ERR(\r
+  {\r
+    int die = 0;\r
+    if (src < pq->start) {\r
+      fprintf(stderr, "src %d less than start %d\n", src, pq->start);\r
+      ++die;\r
+    }\r
+    if (src + count > pq->end) {\r
+      fprintf(stderr, "src %d + count %d beyond end %d\n", src, count, pq->end);\r
+      ++die;\r
+    }\r
+    if (target < 0) {\r
+      fprintf(stderr, "target %d < 0\n", target);\r
+      ++die;\r
+    }\r
+    if (target + count > pq->alloc) {\r
+      fprintf(stderr, "target %d + count %d > alloc\n", target, count, pq->alloc);\r
+      ++die;\r
+    }\r
+    if (die) *(char *)0 = '\0';\r
+  }\r
+  )\r
+  memmove(pq->entries + target, pq->entries + src, count * sizeof(pq_entry));\r
+}\r
+\r
 /*\r
 pq_realloc - make space at the front of back of the queue.\r
 \r
@@ -194,7 +230,6 @@ pq_realloc(poe_queue *pq, int at_end) {
   int count = pq->end - pq->start;\r
 \r
   DEBUG( fprintf(stderr, "pq_realloc((%d, %d, %d), %d)\n", pq->start, pq->end, pq->alloc, at_end) );\r
-  pq_dump(pq);\r
   if (count * 3 / 2 < pq->alloc) {\r
     /* 33 % or more space available, use some of it */\r
     int new_start;\r
@@ -206,8 +241,7 @@ pq_realloc(poe_queue *pq, int at_end) {
       new_start = (pq->alloc - count) * 2 / 3;\r
     }\r
     DEBUG( fprintf(stderr, "  moving start to %d\n", new_start) );\r
-    memmove(pq->entries + new_start, pq->entries + pq->start,\r
-           count * sizeof(pq_entry));\r
+    pq_move_items(pq, new_start, pq->start, count);\r
     pq->start = new_start;\r
     pq->end = new_start + count;\r
   }\r
@@ -224,13 +258,11 @@ pq_realloc(poe_queue *pq, int at_end) {
     if (!at_end) {\r
       int new_start = (new_alloc - count) * 2 / 3;\r
       DEBUG( fprintf(stderr, "  moving start to %d\n", new_start) );\r
-      memmove(pq->entries + new_start, pq->entries + pq->start,\r
-             count * sizeof(pq_entry));\r
+      pq_move_items(pq, new_start, pq->start, count);\r
       pq->start = new_start;\r
       pq->end = new_start + count;\r
     }\r
   }\r
-  pq_dump(pq);\r
   DEBUG( fprintf(stderr, "  final: %d %d %d\n", pq->start, pq->end, pq->alloc) );\r
 }\r
 \r
@@ -302,7 +334,7 @@ pq_enqueue(poe_queue *pq, pq_priority_t priority, SV *payload) {
         i += pq->start - old_start;\r
       }\r
       \r
-      memmove(pq->entries + i + 1, pq->entries + i, (pq->end - i) * sizeof(pq_entry));\r
+      pq_move_items(pq, i+1, i, pq->end - i);\r
       ++pq->end;\r
       fill_at = i;\r
     }\r
@@ -313,8 +345,7 @@ pq_enqueue(poe_queue *pq, pq_priority_t priority, SV *payload) {
        pq_realloc(pq, AT_START);\r
        i += pq->start;\r
       }\r
-      memmove(pq->entries + pq->start - 1, pq->entries + pq->start,\r
-            (i - pq->start) * sizeof(pq_entry));\r
+      pq_move_items(pq, pq->start-1, pq->start, i - pq->start);\r
       --pq->start;\r
       fill_at = i-1;\r
     }\r
@@ -440,10 +471,11 @@ pq_remove_item(poe_queue *pq, pq_id_t id, SV *filter, pq_entry *removed) {
     --pq->end;\r
   }\r
   else {\r
-    memmove(pq->entries + index, pq->entries + index + 1,\r
-           sizeof(pq_entry) * (pq->end - index - 1));\r
+    pq_move_items(pq, index, index+1, pq->end - index - 1);\r
     --pq->end;\r
   }\r
+  DEBUG( fprintf(stderr, "removed (%d, %p (%d))\n", id, removed->payload,\r
+                SvREFCNT(removed->payload)) );\r
 \r
   return 1;\r
 }\r
@@ -522,15 +554,13 @@ pq_set_priority(poe_queue *pq, pq_id_t id, SV *filter, pq_priority_t new_priorit
 \r
       if (insert_at < index) {\r
         DEBUG( fprintf(stderr, "  - insert_at < index\n") );\r
-        memmove(pq->entries + insert_at + 1, pq->entries + insert_at,\r
-               sizeof(pq_entry) * (index - insert_at));\r
+       pq_move_items(pq, insert_at + 1, insert_at, index - insert_at);\r
         pq->entries[insert_at] = saved;\r
       }\r
       else {\r
         DEBUG( fprintf(stderr, "  - insert_at > index\n") );\r
        --insert_at;\r
-       memmove(pq->entries + index, pq->entries + index + 1,\r
-               sizeof(pq_entry) * (insert_at - index));\r
+       pq_move_items(pq, index, index + 1, insert_at - index);\r
         pq->entries[insert_at] = saved;\r
       }\r
     }\r
@@ -584,15 +614,13 @@ pq_adjust_priority(poe_queue *pq, pq_id_t id, SV *filter, double delta, pq_prior
 \r
       if (insert_at < index) {\r
         DEBUG( fprintf(stderr, "  - insert_at < index\n") );\r
-        memmove(pq->entries + insert_at + 1, pq->entries + insert_at,\r
-               sizeof(pq_entry) * (index - insert_at));\r
+       pq_move_items(pq, insert_at + 1, insert_at, index - insert_at);\r
         pq->entries[insert_at] = saved;\r
       }\r
       else {\r
         DEBUG( fprintf(stderr, "  - insert_at > index\n") );\r
        --insert_at;\r
-       memmove(pq->entries + index, pq->entries + index + 1,\r
-               sizeof(pq_entry) * (insert_at - index));\r
+       pq_move_items(pq, index, index + 1, insert_at - index);\r
         pq->entries[insert_at] = saved;\r
       }\r
     }\r

diff --git a/t/02_release.t b/t/02_release.t
new file mode 100644 (file)
index 0000000..0178888
--- /dev/null
+++ b/t/02_release.t
@@ -0,0 +1,160 @@
+#!perl -w
+# checks we're handling references correctly in XS
+# or tries to
+use strict;
+
+use Test::More tests => 37;
+
+my $counter = 'AA';
+
+BEGIN { use_ok("POE::XS::Queue::Array") }
+
+my %released;
+
+my ($obj, $value) = Counter->new;
+
+my $q = POE::XS::Queue::Array->new;
+
+print "# trivial one item and dequeue it\n";
+$q->enqueue(100, $obj);
+undef $obj;
+ok(!$released{$value}, "check it's not released too early");
+$q->dequeue_next; # important we discard this
+ok($released{$value}, "or too late in void context dequeue");
+
+%released = ();
+($obj, $value) = Counter->new;
+# do it in list context
+$q->enqueue(101, $obj);
+undef $obj;
+ok(!$released{$value}, "check early release for list dequeue");
+my @res = $q->dequeue_next;
+ok(!$released{$value}, "check early release for list dequeue (in array)");
+undef @res;
+ok($released{$value} == 1, "should be free now");
+is(keys %released, 1, "check only one released");
+
+print "# remove single item - item at the front - void context\n";
+%released = ();
+($obj, $value) = Counter->new;
+my ($obj2, $value2) = Counter->new;
+my $id = $q->enqueue(102, $obj);
+my $id2 = $q->enqueue(103, $obj2);
+undef $obj;
+undef $obj2;
+ok(!$released{$value}, "check neither ...");
+ok(!$released{$value2}, "... has been released");
+$q->remove_item($id, sub { 1 });
+ok($released{$value}, "check it's released");
+ok(!$released{$value2}, "and other isn't");
+is(keys %released, 1, "check only one released");
+is($q->get_item_count, 1, "check count");
+
+print "# remove single item - item at the front - list context\n";
+%released = ();
+($obj, $value) = Counter->new;
+#my ($obj2, $value2) = Counter->new; # already in the queue
+$id = $q->enqueue(102, $obj);
+# my $id2 = $q->enqueue(103, $obj2); already in the queue
+undef $obj;
+# undef $obj2; done already
+ok(!$released{$value}, "check neither ...");
+ok(!$released{$value2}, "... has been released");
+@res = $q->remove_item($id, sub { 1 });
+undef @res;
+ok($released{$value}, "check it's released");
+ok(!$released{$value2}, "and other isn't");
+is(keys %released, 1, "check only one released");
+
+# list/void context doesn't matter here - it's handled in the XS code and
+# is tested above
+print "# remove single item - item at the end\n";
+%released = ();
+($obj, $value) = Counter->new;
+$id = $q->enqueue(104, $obj);
+undef $obj;
+ok(!$released{$value}, "check not released yet");
+$q->remove_item($id, sub { 1 });
+ok($released{$value}, "check it was released");
+ok(!$released{$value2}, "and other isn't");
+is(keys %released, 1, "check only one released");
+
+print "# remove single item - item in the middle\n";
+%released = ();
+($obj, $value) = Counter->new;
+my ($obj3, $value3) = Counter->new;
+$id = $q->enqueue(102, $obj);
+my $id3 = $q->enqueue(104, $obj3);
+undef $obj;
+undef $obj3;
+$q->remove_item($id2, sub { 1 });
+ok($released{$value2}, "check it was released");
+ok(!$released{$value}, "and others ...");
+ok(!$released{$value3}, "... weren't");
+
+print "# peek at the contents\n";
+%released = ();
+@res = $q->peek_items(sub { 1 });
+is(keys %released, 0, "check nothing released");
+undef @res;
+is(keys %released, 0, "still nothing released");
+$q->remove_item($id, sub { 1 });
+ok($released{$value}, "check one released");
+$q->remove_item($id3, sub { 1 });
+ok($released{$value3}, "check other released");
+is(keys %released, 2, "check nothing else released");
+
+print "# bulk removal\n";
+%released = ();
+($obj, $value) = Counter->new;
+($obj2, $value2) = Counter->new;
+($obj3, $value3) = Counter->new;
+$q->enqueue(101, $obj);
+$q->enqueue(103, $obj2);
+$q->enqueue(102, $obj3);
+undef $obj;
+undef $obj2;
+undef $obj3;
+@res = $q->remove_items(sub { ${$_[0]} eq $value3 });
+is(keys %released, 0, "nothing released yet");
+undef @res;
+ok($released{$value3}, "check it was released");
+is(keys %released, 1, "and nothing else");
+# remove the rest
+$q->remove_items(sub { 1 });
+ok($released{$value}, "check both ...");
+ok($released{$value2}, "... have been released");
+is(keys %released, 3, "and nothing else");
+is($q->get_item_count, 0, "and queue is empty");
+
+# priority adjustments
+%released = ();
+($obj, $value) = Counter->new;
+($obj2, $value2) = Counter->new;
+($obj3, $value3) = Counter->new;
+$q->enqueue(101, $obj);
+$q->enqueue(102, $obj2);
+$q->enqueue(103, $obj3);
+undef $obj;
+undef $obj2;
+undef $obj3;
+
+
+# test class used to track destruction
+sub Counter::new {
+  my $foo = $counter++;
+  print "# created $foo\n";
+  if (wantarray) {
+    return ( (bless \$foo, shift), $foo );
+  }
+  else {
+    return bless \$foo, shift;
+  }
+}
+
+sub Counter::value { ${$_[0]} }
+
+sub Counter::DESTROY { 
+  print "# destroyed ${$_[0]}\n";
+  ++$released{${$_[0]}}
+}