Gtk2-Ex-Xor

 view release on metacpan or  search on metacpan

devel/cross-ids.pl  view on Meta::CPAN

is_deeply (leftover_fields($widget), [],
           'weaken active - initially no CrossHair data');

my $cross = Gtk2::Ex::CrossHair->new (widget => $widget);
is_deeply (leftover_fields($widget), [],
           'weaken active - initially no CrossHair data');
$cross->start;
diag explain $cross;
# sync and iterate to make the cross draw and use its gc
$display->sync;
MyTestHelpers::main_iterations();

is_deeply (leftover_fields($widget), [],
           'weaken active - initially no CrossHair data');

my $weak_cross = $cross;
Scalar::Util::weaken ($weak_cross);
$cross = undef;
MyTestHelpers::main_iterations();
is ($weak_cross, undef, 'weaken active - destroyed');
is_deeply (leftover_fields($widget), [],
           'weaken active - no CrossHair data left behind');

$widget->destroy;
$display->warp_pointer($screen,$x,$y);
exit 0;
}

  my $toplevel = Gtk2::Window->new('toplevel');

t/CrossHair.t  view on Meta::CPAN

}

# destroyed when weakened on unrealized
{
  my $widget = Gtk2::Window->new ('toplevel');
  my $cross = Gtk2::Ex::CrossHair->new (widget => $widget);
  my $weak_cross = $cross;
  require Scalar::Util;
  Scalar::Util::weaken ($weak_cross);
  undef $cross;
  MyTestHelpers::main_iterations();
  is ($weak_cross, undef, 'weaken unrealized - destroyed');
  if (defined &explain) {
    diag explain($widget);
    diag explain($weak_cross);
  }
  if ($weak_cross) {
    MyTestHelpers::findrefs ($weak_cross);
  }
  is_deeply (leftover_fields($widget), [],
             'weaken unrealized - no CrossHair data left behind');

t/CrossHair.t  view on Meta::CPAN

  my ($widget_x,$widget_y) = $widget->window->get_origin;
  $display->warp_pointer($widget->get_screen,$widget_x+50,$widget_y+50);

  is_deeply (leftover_fields($widget), [],
             'weaken active - initially no CrossHair data');

  my $cross = Gtk2::Ex::CrossHair->new (widget => $widget);
  $cross->start;
  # sync and iterate to make the cross draw and use its gc
  $display->sync;
  MyTestHelpers::main_iterations();

  my $weak_cross = $cross;
  Scalar::Util::weaken ($weak_cross);
  $cross = undef;
  MyTestHelpers::main_iterations();
  is ($weak_cross, undef, 'weaken active - destroyed');
  if ($weak_cross) {
    if (defined &explain) { diag explain($weak_cross); }
    MyTestHelpers::findrefs ($weak_cross);
  }
  is_deeply (leftover_fields($widget), [],
             'weaken active - no CrossHair data left behind');

  $widget->destroy;
  $display->warp_pointer($screen,$x,$y);

t/CrossHair.t  view on Meta::CPAN

  # temporary warp to have mouse pointer within $widget
  my $display = $widget->get_display;
  my ($screen,$x,$y) = $display->get_pointer;
  my ($widget_x,$widget_y) = $widget->window->get_origin;
  $display->warp_pointer($widget->get_screen,$widget_x+50,$widget_y+50);

  my $cross = Gtk2::Ex::CrossHair->new (widget => $widget);
  $cross->start;
  # sync and iterate to make the cross draw and use its gc
  $display->sync;
  MyTestHelpers::main_iterations();

  $cross->set (widget => $widget2);
  ($widget_x,$widget_y) = $widget2->window->get_origin;
  $display->warp_pointer($widget2->get_screen,$widget_x+50,$widget_y+50);
  $display->sync;
  MyTestHelpers::main_iterations();

  # if (defined &explain) {
  #   diag explain($widget);
  # }
  is_deeply (leftover_fields($widget), [],
             'change widget - no CrossHair data left behind');

  $cross->set (widgets => []);
  is_deeply (leftover_fields($widget2), [],
             'change to no widgets - no CrossHair data left behind');

t/Lasso.t  view on Meta::CPAN

# destroyed when weakened inactive
{
  my $widget = Gtk2::Window->new ('toplevel');
  my $lasso = Gtk2::Ex::Lasso->new (widget => $widget);
  my $weak_lasso = $lasso;
  require Scalar::Util;
  Scalar::Util::weaken ($weak_lasso);
  $lasso = undef;
  MyTestHelpers::main_iterations();
  is ($weak_lasso, undef, 'inactive Lasso weakened');
  is_deeply (leftover_fields($widget), [],
             'no Lasso data left behind from inactive');
  $widget->destroy;
}

# destroyed when weakened active
{
  my $widget = Gtk2::Window->new ('toplevel');
  my $lasso = Gtk2::Ex::Lasso->new (widget => $widget);

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 {