Gtk2-Ex-WidgetCursor

 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/overload.t  view on Meta::CPAN

  plan skip_all => 'somehow overloaded widget+0 no error, maybe perl 5.8.3 badness';
}

plan tests => 2;

isa_ok ($widget, 'MyOverloadWidget');

my $toplevel = Gtk2::Window->new;
$toplevel->add ($widget);
$toplevel->show_all;
MyTestHelpers::main_iterations();

my $wobj = Gtk2::Ex::WidgetCursor->new (widgets => [$toplevel,$widget],
                                        active => 1,
                                        include_children => 1,
                                        cursor => 'invisible');
Gtk2::Ex::WidgetCursor->busy;

$toplevel->destroy;
ok (1);

t/test-weaken.t  view on Meta::CPAN

  }
}

{
  my $leaks = Test::Weaken::leaks
    ({ constructor => sub {
         my $toplevel = Gtk2::Window->new ('toplevel');
         $toplevel->show;
         my $wcursor = Gtk2::Ex::WidgetCursor->new (widget => $toplevel,
                                                    active => 1);
         MyTestHelpers::main_iterations();
         return [ $toplevel, $wcursor ];
       },
       destructor => \&Test::Weaken::Gtk2::destructor_destroy,
     });
  is ($leaks, undef, 'toplevel, shown and active');
  if ($leaks && defined &explain) {
    diag "Test-Weaken ", explain($leaks);
  }
}