Glib-Ex-ConnectProperties

 view release on metacpan or  search on metacpan

t/MyTestHelpers.pm  view on Meta::CPAN

# Don't want to load Exporter here since that could hide a problem of a
# module missing a "use Exporter".  Though Test.pm and Test::More (via
# Test::Builder::Module) both use it anyway.
#
# use Exporter;
# use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
# @ISA = ('Exporter');
# @EXPORT_OK = qw(findrefs
#                 main_iterations
#                 warn_suppress_gtk_icon
#                 glib_gtk_versions
#                 any_signal_connections
#                 nowarnings);
# %EXPORT_TAGS = (all => \@EXPORT_OK);

sub DEBUG { 0 }


#-----------------------------------------------------------------------------

t/MyTestHelpers.pm  view on Meta::CPAN

    MyTestHelpers::diag ("search ", $proberef);
    MyTestHelpers::findrefs($proberef);
  }
}

#-----------------------------------------------------------------------------
# Gtk/Glib helpers

# Gtk 2.16 can go into a hard loop on events_pending() / main_iteration_do()
# if dbus is not running, or something like that.  In any case limiting the
# iterations is good for test safety.
#
sub main_iterations {
  my $count = 0;
  if (DEBUG) { MyTestHelpers::diag ("main_iterations() ..."); }
  while (Gtk2->events_pending) {
    $count++;
    Gtk2->main_iteration_do (0);

    if ($count >= 500) {
      MyTestHelpers::diag ("main_iterations(): oops, bailed out after $count events/iterations");
      return;
    }
  }
  MyTestHelpers::diag ("main_iterations(): ran $count events/iterations");
}

# warn_suppress_gtk_icon() is a $SIG{__WARN__} handler which suppresses spam
# from Gtk trying to make you buy the hi-colour icon theme.  Eg,
#
#     {
#       local $SIG{'__WARN__'} = \&MyTestHelpers::warn_suppress_gtk_icon;
#       $something = SomeThing->new;
#     }
#

t/MyTestHelpers.pm  view on Meta::CPAN

    # in Gtk 2.0 gdk_flush() is a sync actually
    Gtk2::Gdk->flush;
  }

  my $count = 0;
  while (! $done) {
    if (DEBUG >= 2) { MyTestHelpers::diag ("wait_for_event()   iteration $count"); }
    Gtk2->main_iteration;
    $count++;
  }
  MyTestHelpers::diag ("wait_for_event(): '$signame' ran $count events/iterations\n");

  $widget->signal_handler_disconnect ($sig_id);
  Glib::Source->remove ($timer_id);
}


#-----------------------------------------------------------------------------
# X11::Protocol helpers

sub X11_chosen_screen_number {

t/widget_allocation.t  view on Meta::CPAN

  my $size_allocate_ran = 0;
  $draw->signal_connect (size_allocate => sub {
                           diag "draw size-allocate signal runs";
                           $size_allocate_ran = 1;
                         });

  $fixed->put ($draw, 20,10);
  $toplevel->show_all;

  # might have to loop to get queued resizes processed
  MyTestHelpers::main_iterations();

  ok ($size_allocate_ran, 'draw size-allocate signal runs');
  #   diag $draw->size_request->width;
  ### draw allocation: $draw->allocation->values

  my $foo_width  = Foo->new;
  my $foo_height = Foo->new;
  my $foo_x      = Foo->new;
  my $foo_y      = Foo->new;
  my $bar        = Bar->new;

t/widget_allocation.t  view on Meta::CPAN

  {
    my $rect = $bar->get('myrect');
    is ($rect && $rect->width, 2000);
    is ($rect && $rect->height, 1000);
    is ($rect && $rect->x, 20);
    is ($rect && $rect->y, 10);
  }

  $draw->set_size_request (500, 300);
  # must loop for $fixed to act on queued resize
  MyTestHelpers::main_iterations();

  is ($foo_width->get('mystring'), 500);
  is ($foo_height->get('mystring'), 300);
  is ($foo_x->get('mystring'), 20);
  is ($foo_y->get('mystring'), 10);
  {
    my $rect = $bar->get('myrect');
    is ($rect && $rect->width, 500);
    is ($rect && $rect->height, 300);
    is ($rect && $rect->x, 20);

t/widget_allocation.t  view on Meta::CPAN

  my $size_allocate_ran = 0;
  $nowin->signal_connect (size_allocate => sub {
                           diag "draw size-allocate signal runs";
                           $size_allocate_ran = 1;
                         });

  $fixed->put ($nowin, 2,1);
  $toplevel->show_all;

  # might have to loop to get queued resizes processed
  MyTestHelpers::main_iterations();

  ok ($size_allocate_ran, 'draw size-allocate signal runs');

  my $foo_x      = Foo->new;
  my $foo_y      = Foo->new;
  Glib::Ex::ConnectProperties->new ([$nowin,'widget-allocation#x'],
                                    [$foo_x,'mystring']);
  Glib::Ex::ConnectProperties->new ([$nowin,'widget-allocation#y'],
                                    [$foo_y,'mystring']);
  is ($foo_x->get('mystring'), 2);
  is ($foo_y->get('mystring'), 1);

  $fixed->move ($nowin, 4,3);

  # might have to loop for $fixed to act
  MyTestHelpers::main_iterations();

  is ($foo_x->get('mystring'), 4);
  is ($foo_y->get('mystring'), 3);

  $toplevel->destroy;
}

exit 0;