Skip to content
Browse files

Fixed a retrival bug in SDL::Event from user_data when data enter is …

…out of scope. Also made a preliminary SDLx::Queue. Not sure if dequeue is blocking or not though.
  • Loading branch information...
1 parent e22d5a3 commit 425fad419111272b68df9f5d32a897046a3c2057 @kthakore kthakore committed
Showing with 124 additions and 4 deletions.
  1. +73 −0 lib/SDLx/Queue.pm
  2. +7 −4 src/Core/objects/Event.xs
  3. +44 −0 t/sdlx_queue.t
View
73 lib/SDLx/Queue.pm
@@ -0,0 +1,73 @@
+package SDLx::Queue;
+use strict;
+use warnings;
+use Carp;
+use SDL;
+use SDL::Event;
+use SDL::Events;
+
+use Data::Dumper;
+
+
+sub enqueue
+{
+ my ($queue_name, $event) = @_;
+
+
+my $userdata = SDL::Event->new();
+$userdata->type(SDL_USEREVENT);
+$userdata->user_data1( $queue_name );
+$userdata->user_data2( $event );
+
+ if( SDL::Events::push_event( $userdata ) < 0 )
+ {
+ Carp::carp 'Cannot push_event :'.SDL::get_error();
+ }
+
+ return $userdata;
+
+}
+
+sub dequeue
+{
+ my ($queue_name) = @_;
+
+ my $peep_event = SDL::Event->new();
+ my $event = SDL::Event->new();
+
+ my $queue_ref = '';
+ my $data_ref = '';
+
+ SDL::Events::pump_events;
+ while( my $peepd = SDL::Events::peep_events( $peep_event, 1, SDL_GETEVENT, SDL_ALLEVENTS ) )
+ {
+ return -1 if $peepd == 0;
+
+ if ($peepd == -1) { Carp::croak 'Cannot peep events : '.SDL::get_error(); };
+
+ if ( $peep_event->type == SDL_USEREVENT)
+ {
+ $queue_ref = $peep_event->user_data1;
+ $data_ref = $peep_event->user_data2;
+ if( defined $queue_ref && $$queue_ref eq $queue_name )
+ {
+ return $$data_ref ;
+ }
+ else
+ {
+
+ SDL::Events::peep_events( $peep_event, 1, SDL_ADDEVENT, SDL_ALLEVENTS )
+
+ }
+ }
+
+
+ }
+ return $data_ref;
+
+}
+
+
+1;
+
+
View
11 src/Core/objects/Event.xs
@@ -11,10 +11,13 @@
SV* new_data( SV* thing )
{
+ SV* new_thing;
if ( SvROK( thing ) )
- return newRV_inc(SvRV(thing ) );
+ { new_thing = SvRV(thing); }
else
- return SvREFCNT_inc(thing);
+ { new_thing = thing; }
+
+ return SvREFCNT_inc(newRV_inc(new_thing));
}
@@ -901,8 +904,8 @@ event_user_data1 ( event, ... )
PPCODE:
SDL_UserEvent * a = &(event->user);
if ( items > 1)
- a->data1 = new_data( ST(1) );
- if (!a->data1)
+ a->data1 = new_data( ST(1) );
+ if (!a->data1)
XSRETURN_EMPTY;
ST(0) = a->data1;
XSRETURN(1);
View
44 t/sdlx_queue.t
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+use strict;
+use SDL;
+use SDL::Video;
+use SDLx::Queue;
+use Test::More;
+use lib 't/lib';
+use SDL::TestTool;
+
+my $videodriver = $ENV{SDL_VIDEODRIVER};
+$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
+
+if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
+ plan( skip_all => 'Failed to init video' );
+}
+
+
+SDLx::Queue::enqueue( 'foo', 'Data' );
+SDLx::Queue::enqueue( 'foo1', 'Data' );
+
+SDLx::Queue::enqueue( 'foo1', 'Data 1' );
+SDLx::Queue::enqueue( 'foo', 'Data 1' );
+
+
+is( SDLx::Queue::dequeue( 'foo1' ), 'Data' , 'Got data for foo queue');
+
+is( SDLx::Queue::dequeue( 'foo' ), 'Data 1', 'Got data for foo1 queue');
+
+is( SDLx::Queue::dequeue( 'foo' ), 'Data', 'Got data for foo1 queue');
+
+is( SDLx::Queue::dequeue( 'foo1' ), 'Data 1' , 'Got data for foo queue');
+
+
+if ($videodriver) {
+ $ENV{SDL_VIDEODRIVER} = $videodriver;
+} else {
+ delete $ENV{SDL_VIDEODRIVER};
+}
+
+#SDL::quit();
+pass 'Are we still alive? Checking for segfaults';
+
+done_testing;
+sleep(2);

0 comments on commit 425fad4

Please sign in to comment.
Something went wrong with that request. Please try again.