git.maemo.org Git - pkg-perl/blob - deb-src/libwx-perl/libwx-perl-0.96/t/17_thread_evt.t

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use Config;
   5 use if !$Config{useithreads} => 'Test::More' => skip_all => 'no threads';
   6 use threads;
   7 use threads::shared;
   8
   9 use Wx;
  10 use if !Wx::wxTHREADS(), 'Test::More' => skip_all => 'No thread support';
  11 use if Wx::wxVERSION < 2.006, 'Test::More' => skip_all => 'Hangs under 2.5';
  12 use Test::More tests => 2;
  13
  14 {
  15     package MyFrame;
  16
  17     use base 'Wx::Frame';
  18 }
  19
  20 my $app = Wx::App->new( sub { 1 } );
  21 my $frame = MyFrame->new( undef, -1, 'Test' );
  22 my $timer = Wx::Timer->new( $frame );
  23
  24 my $TEST_DONE_EVENT : shared = Wx::NewEventType;
  25
  26 # avoid use()ing Wx::Event on purpose
  27 Wx::Event::EVT_COMMAND( $frame, -1, $TEST_DONE_EVENT, \&got_thread_event );
  28 Wx::Event::EVT_TIMER( $frame, -1, \&got_timer_event );
  29
  30 $timer->Start( 800, 1 );
  31 $app->MainLoop;
  32
  33 pass; # ended successfully
  34
  35 sub got_timer_event {
  36     my( $frame, $event ) = @_; @_ = (); # hack to avoid "Scalars leaked"
  37
  38     start_thread( $frame );
  39 }
  40
  41 sub start_thread {
  42     my( $frame ) = @_;
  43
  44     my $thread = threads->new( \&send_thread_event, $frame );
  45     $thread->join;
  46 }
  47
  48 sub send_thread_event {
  49     my( $frame ) = @_;
  50
  51     my $threvent = new Wx::PlThreadEvent( -1, $TEST_DONE_EVENT, 123 );
  52     Wx::PostEvent( $frame, $threvent );
  53 }
  54
  55 sub got_thread_event {
  56     pass;
  57
  58     $frame->Destroy;
  59 }
  60