tweak steffen's pull request so that the context will determine what …

…gets returned
lestrrat-p5 · Apr 19, 2012 · 3ebcdd5 · 3ebcdd5
1 parent 46a114f
commit 3ebcdd5
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 32 deletions.
diff --git a/ZMQ-LibZMQ2/t/005_poll.t b/ZMQ-LibZMQ2/t/005_poll.t
@@ -20,9 +20,23 @@ subtest 'basic poll with fd' => sub {
                 }
             ], 1);
             ok $called, "callback called";
-            ok(ref($rv) && ref($rv) eq 'ARRAY' && @$rv == 1 && $rv->[0] == $called,
-               "zmq_poll returns an array ref indicating whether the callback was invoked");
-        }, undef, "PollItem doesn't die";
+            ok($rv,
+               "zmq_poll returns a scalar ndicating whether the callback was invoked");
+        }, undef, "PollItem (return scalar) doesn't die";
+
+        is exception {
+            my $called = 0;
+            my @rv = zmq_poll([
+                {
+                    fd       => fileno(STDOUT),
+                    events   => ZMQ_POLLOUT,
+                    callback => sub { $called++ }
+                }
+            ], 1);
+            ok $called, "callback called";
+            ok(@rv == 1 && $rv[0] == $called,
+               "zmq_poll returns an array indicating whether the callback was invoked");
+        }, undef, "PollItem (return array) doesn't die";
     }
 };
 
@@ -38,7 +52,7 @@ subtest 'poll with zmq sockets' => sub {
         zmq_connect($req[$_], "inproc://polltest$_") for 0..$n-1;
         zmq_send( $req[$_], "Test$_") for 0..$nsend-1;
 
-        my $rv = zmq_poll([
+        my @rv = zmq_poll([
             map {
                 my $x = $_;
                 +{
@@ -50,7 +64,7 @@ subtest 'poll with zmq sockets' => sub {
             (0..$n-1)
         ], 1);
         my $exp_rv = [((1) x $nsend), ((0) x ($n-$nsend))];
-        is_deeply($rv, $exp_rv,
+        is_deeply(\@rv, $exp_rv,
                   "zmq_poll returns an array ref indicating whether the callback was invoked");
     }, undef, "PollItem correctly handles callback";
 

diff --git a/ZMQ-LibZMQ2/xs/perl_libzmq2.xs b/ZMQ-LibZMQ2/xs/perl_libzmq2.xs
@@ -763,7 +763,7 @@ PerlLibzmq2_zmq_poll( list, timeout = 0 )
         int rv;
         int eventfired;
         AV *events_fired;
-    CODE:
+    PPCODE:
         list_len = av_len( list ) + 1;
         if (list_len <= 0) {
             XSRETURN(0);
@@ -829,37 +829,34 @@ PerlLibzmq2_zmq_poll( list, timeout = 0 )
 
         /* now call zmq_poll */
         rv = zmq_poll( pollitems, list_len, timeout );
-        if (rv < 0) {
-            SET_BANG;
-            RETVAL = &PL_sv_undef;
-        }
-        else {
-            events_fired = newAV();
-            RETVAL = newRV_noinc((SV *)events_fired);
-            av_fill(events_fired, list_len-1);
-            for ( i = 0; i < list_len; i++ ) {
+        SET_BANG;
+
+        for ( i = 0; i < list_len; i++ ) {
+            if (GIMME_V == G_ARRAY) {
                 eventfired = (pollitems[i].revents & pollitems[i].events) ? 1 : 0;
-                av_store(events_fired, i, newSViv(eventfired));
-                if (pollitems[i].revents & pollitems[i].events) {
-                    dSP;
-                    ENTER;
-                    SAVETMPS;
-                    PUSHMARK(SP);
-                    PUTBACK;
-
-                    call_sv( (SV*)callbacks[i], G_SCALAR );
-                    SPAGAIN;
-
-                    PUTBACK;
-                    FREETMPS;
-                    LEAVE;
-                }
+                mXPUSHi(eventfired);
+            }
+            if (pollitems[i].revents & pollitems[i].events) {
+                dSP;
+                ENTER;
+                SAVETMPS;
+                PUSHMARK(SP);
+                PUTBACK;
+
+                call_sv( (SV*)callbacks[i], G_SCALAR );
+                SPAGAIN;
+
+                PUTBACK;
+                FREETMPS;
+                LEAVE;
             }
         }
+
+        if (GIMME_V == G_SCALAR) {
+            mXPUSHi(rv);
+        }
         Safefree(pollitems);
         Safefree(callbacks);
-    OUTPUT:
-        RETVAL
 
 int
 PerlLibzmq2_zmq_device( device, insocket, outsocket )