Gtk2-Ex-WidgetBits

 view release on metacpan or  search on metacpan

lib/Test/Weaken/Gtk2.pm  view on Meta::CPAN

  my ($ref) = @_;
  if (ref($ref) eq 'ARRAY') {
    $ref = $ref->[0];
  }
  $ref->destroy;
}

sub destructor_destroy_and_iterate {
  my ($ref) = @_;
  destructor_destroy ($ref);
  _main_iterations();
}

# 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.
#
# FIXME: Not sure how aggressive to be on hitting the maximum count.  If
# testing can likely continue then a diagnostic is enough, but maybe a
# count-out means something too broken to continue.
#
# The iterations count actually run is cute to see to check what has gone
# through the main loop.  Would it be worth giving that always, or under an
# option, or something?
#
sub _main_iterations {
  require Test::More;
  my $count = 0;
  ### _main_iterations() ...
  while (Gtk2->events_pending) {
    $count++;
    Gtk2->main_iteration_do (0);

    if ($count >= 1000) {
      ### _main_iterations() count exceeded: $count
      eval {
        Test::More::diag ("main_iterations(): oops, bailed out after $count events/iterations");
      };
      return;
    }
  }
  ### _main_iterations() events/iterations: $count
}

#------------------------------------------------------------------------------
sub ignore_default_display {
  my ($ref) = @_;

  # Gtk2 loaded, and Gtk 2.2 up
  Gtk2::Gdk::Display->can('get_default') || return 0;

  my $default_display = Gtk2::Gdk::Display->get_default

lib/Test/Weaken/Gtk2.pm  view on Meta::CPAN

All C<Gtk2::Object>s support C<destroy()> but most don't need it for garbage
collection.  C<Gtk2::Window> is the most common which does.  Another is a
MenuItem which has an AccelLabel and is not in a menu (see notes in
L<Gtk2::MenuItem>).

=item C<< Test::Weaken::Gtk2::destructor_destroy_and_iterate ($top) >>

The same as C<destructor_destroy()> above, but in addition run
C<< Gtk2->main_iteration_do() >> for queued main loop actions.  There's a
limit on the number of iterations done, so as to protect against a runaway
main loop.

This is good if some finalizations are only done in an idle handler, or
perhaps under a timer which has now expired.  Currently queued events from
the X server are run, but there's no read or wait for further events.

=back

=head2 Ignore Functions

t/MenuBits.t  view on Meta::CPAN

             'when not in a toplevel');

  my $toplevel = Gtk2::Window->new('toplevel');
  $toplevel->add ($widget);
  is_deeply ([ Gtk2::Ex::MenuBits::position_widget_topcentre
               ($menu, -12345, -6789, $widget) ],
             [ -12345, -6789, 1 ],
             'when not realized');

  $toplevel->show_all;
  # MyTestHelpers::main_iterations();
  # diag $toplevel->window;
  # diag $widget->window;
  my ($x,$y,$push_in) = Gtk2::Ex::MenuBits::position_widget_topcentre
    ($menu, -123456, -654321, $widget);
  isnt ($x, -123456,
        'with show_all()');

  $toplevel->destroy;
}

t/MyTestHelpers.pm  view on Meta::CPAN

package MyTestHelpers;
use strict;
use Exporter;
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);

# uncomment this to run the ### lines
#use Smart::Comments;

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

      'only weak reference held to statusbar');
}

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

{
  my $toplevel = Gtk2::Window->new('toplevel');
  my $statusbar = Gtk2::Statusbar->new;
  $toplevel->add($statusbar);
  $toplevel->show_all;
  MyTestHelpers::main_iterations();
  my $msg = Gtk2::Ex::Statusbar::Message->new
    (statusbar => $statusbar,
     message => 'hello');
  $msg->{'circular'} = $statusbar;
  $statusbar->{'circular'} = $msg;
}

exit 0;

t/ToolItem-OverflowToDialog-weaken.t  view on Meta::CPAN

{
  my $leaks = Test::Weaken::leaks
    ({ constructor => sub {
         my $toolitem = Gtk2::Ex::ToolItem::OverflowToDialog->new;
         my $menuitem = $toolitem->retrieve_proxy_menu_item;
         isa_ok ($menuitem, 'Gtk2::MenuItem');
         $menuitem->activate;
         my $dialog = $toolitem->{'dialog'};
         isa_ok ($dialog, 'Gtk2::Ex::ToolItem::OverflowToDialog::Dialog');
         $dialog->present;
         MyTestHelpers::main_iterations();
         return [ $toolitem, $menuitem, $dialog ];
       },
       contents => \&Test::Weaken::Gtk2::contents_container,
     });
  is ($leaks, undef, 'with dialog open');
  MyTestHelpers::test_weaken_show_leaks($leaks);
}

exit 0;

t/ToolItem-OverflowToDialog.t  view on Meta::CPAN

    (child => $child_widget);
  is ($toolitem->get_child, $child_widget);
}

#------------------------------------------------------------------------------
# weaken

{
  my $toolitem =  Gtk2::Ex::ToolItem::OverflowToDialog->new;
  Scalar::Util::weaken($toolitem);
  MyTestHelpers::main_iterations();
  is ($toolitem, undef, 'toolitem weaken away');
}
{
  my $child_widget = Gtk2::Button->new;
  my $toolitem =  Gtk2::Ex::ToolItem::OverflowToDialog->new
    (child_widget => $child_widget);
  Scalar::Util::weaken($toolitem);
  MyTestHelpers::main_iterations();
  is ($toolitem, undef, 'toolitem weaken away');
}
{
  my $child_widget = Gtk2::Button->new;
  my $toolitem =  Gtk2::Ex::ToolItem::OverflowToDialog->new
    (child_widget => $child_widget);
  my $menuitem = $toolitem->retrieve_proxy_menu_item;
  Scalar::Util::weaken($toolitem);
  Scalar::Util::weaken($menuitem);
  MyTestHelpers::main_iterations();
  is ($toolitem, undef, 'toolitem with menu weaken away');
  is ($menuitem, undef, 'menuitem weaken away');
}
{
  my $child_widget = Gtk2::Button->new;
  my $toolitem =  Gtk2::Ex::ToolItem::OverflowToDialog->new
    (child_widget => $child_widget);
  my $menuitem = $toolitem->retrieve_proxy_menu_item;
  my $dialog = force_dialog($toolitem);
  Scalar::Util::weaken($toolitem);
  Scalar::Util::weaken($menuitem);
  Scalar::Util::weaken($dialog);
  MyTestHelpers::main_iterations();
  is ($toolitem, undef, 'toolitem with dialog weaken away');
  is ($menuitem, undef, 'menuitem weaken away');
  is ($dialog, undef, 'dialog weaken away');
}
  # Scalar::Util::weaken($child_widget);
  # is ($child_widget, undef, 'prev child_widget weaken away');


#------------------------------------------------------------------------------
# add()

t/WidgetBits.t  view on Meta::CPAN

    diag ("layout   at $layout_xy[0], $layout_xy[1]");
    is (scalar @layout_xy, 2,
        'get_root_position() on contained layout, num retvals');
    is_deeply (\@layout_xy, \@top_xy,
               'get_root_position() contained layout, same as toplevel');
  }

  my $label = Gtk2::Label->new ('x');
  $layout->put ($label, 20, 30);
  $toplevel->show_all;
  MyTestHelpers::main_iterations();
  {
    my @top_xy = Gtk2::Ex::WidgetBits::get_root_position ($toplevel);
    diag ("toplevel at $top_xy[0], $top_xy[1]");
    my @label_xy = Gtk2::Ex::WidgetBits::get_root_position ($label);
    diag ("label   at $label_xy[0], $label_xy[1]");
    is (scalar @label_xy, 2,
        'get_root_position() on label in layout, num retvals');
    is_deeply ([ Gtk2::Ex::WidgetBits::get_root_position ($label) ],
               [ $top_xy[0] + 20, $top_xy[1] + 30 ],
               'get_root_position() on label in layout, at toplevel+offset');