view release on metacpan or  search on metacpan

t/Lasso.t  view on Meta::CPAN

    }
  };
  $lasso->start;
}

#------------------------------------------------------------------------------
# VERSION

my $want_version = 23;
is ($Gtk2::Ex::Lasso::VERSION, $want_version, 'VERSION variable');
is (Gtk2::Ex::Lasso->VERSION,  $want_version, 'VERSION class method');
{ ok (eval { Gtk2::Ex::Lasso->VERSION($want_version); 1 },
      "VERSION class check $want_version");
  my $check_version = $want_version + 1000;
  ok (! eval { Gtk2::Ex::Lasso->VERSION($check_version); 1 },
      "VERSION class check $check_version");
}
{
  my $lasso = Gtk2::Ex::Lasso->new;
  is ($lasso->VERSION, $want_version, 'VERSION object method');
  ok (eval { $lasso->VERSION($want_version); 1 },
      "VERSION object check $want_version");
  my $check_version = $want_version + 1000;
  ok (! eval { $lasso->VERSION($check_version); 1 },
      "VERSION object check $check_version");
}

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

sub show_wait {
  my ($widget) = @_;
  my $t_id = Glib::Timeout->add (10_000, sub {
                                   diag "Timeout waiting for map event";
                                   exit 1;
                                 });
  my $s_id = $widget->signal_connect (map_event => sub {
                                        Gtk2->main_quit;
                                        return 0; # propagate event
                                      });
  $widget->show;
  Gtk2->main;
  $widget->signal_handler_disconnect ($s_id);
  Glib::Source->remove ($t_id);
}

# return an arrayref
sub leftover_fields {
  my ($widget) = @_;
  return [ grep /Gtk2::Ex::Lasso/, keys %$widget ];
}


# 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);
  show_wait ($widget);
  my_lasso_start($lasso);
  my $weak_lasso = $lasso;
  Scalar::Util::weaken ($weak_lasso);
  $lasso = undef;
  is ($weak_lasso, undef, 'active Lasso weakened');
  is_deeply (leftover_fields($widget), [],
             'no Lasso data left behind from active');
  $widget->destroy;
}

# start() emits "notify::active"
{
  my $widget = Gtk2::Window->new ('toplevel');
  show_wait ($widget);
  my $lasso = Gtk2::Ex::Lasso->new (widget => $widget);
  my $seen_notify = 0;
  $lasso->signal_connect ('notify::active' => sub { $seen_notify = 1; });
  my_lasso_start($lasso);
  is ($seen_notify, 1, 'start() emits notify::active');
  $widget->destroy;
}

# end() emits "notify::active"
{
  my $widget = Gtk2::Window->new ('toplevel');
  show_wait ($widget);
  my $lasso = Gtk2::Ex::Lasso->new (widget => $widget);
  my_lasso_start($lasso);
  my $seen_notify = 0;
  $lasso->signal_connect ('notify::active' => sub { $seen_notify = 1; });
  $lasso->end;
  is ($seen_notify, 1, 'end() emits notify::active');
  $widget->destroy;
}

#------------------------------------------------------------------------------
# cursor properties

# return true if two Glib::Boxed objects $b1 and $b2 point to the same
# underlying C object
sub glib_boxed_equal {
  my ($b1, $b2) = @_;
  if (! defined $b1 || ! defined $b2) {
    return 0;
  }
  diag "b1 type:";
  diag $b1->type;
  my $pspec = Glib::ParamSpec->boxed ('equal', 'equal', 'blurb', ref($b1),
                                      Glib::G_PARAM_READWRITE());