view release on metacpan or  search on metacpan

t/History.t  view on Meta::CPAN

# place-equal handler

{
  my $history = Gtk2::Ex::History->new;
  my $equal_called = 0;
  my $equal_history;
  $history->signal_connect (place_equal => sub {
                              my ($h, $p1, $p2) = @_;
                              $equal_history = $h;
                              $equal_called = 1;
                              return ($p1 == $p2);
                            });
  my $got = $history->signal_emit ('place-equal', 1, 1);
  ok ($equal_called, 'place-equal handler - called');
  is ($equal_history, $history, 'place-equal handler - history obj arg');
  is (  $got, 1, 'place-equal handler - result');
  ok (! $history->signal_emit ('place-equal', 1, 2),
      'place-equal handler - args 1 2 are not equal');
  ok (  $history->signal_emit ('place-equal', '1.0', 1),
        'place-equal handler - args 1.0 1 are equal');
}

#------------------------------------------------------------------------------
# _default_place_to_text()

{
  my $history = Gtk2::Ex::History->new;
  is ($history->signal_emit ('place-to-text', 'abc'), 'abc',
      '_default_place_to_text() string arg');
  {
    my $place = ['hello'];
    my $place_str = "$place";
    is ($history->signal_emit ('place-to-text', $place), $place_str,
        '_default_place_to_text() stringize ref');
  }
}

#------------------------------------------------------------------------------
# place-to-text handler

{
  my $history = Gtk2::Ex::History->new;
  my $to_text_called = 0;
  my $to_text_h;
  $history->signal_connect (place_to_text => sub {
                              my ($h, $place) = @_;
                              $to_text_called = 1;
                              $to_text_h = $h;
                              return "xx $place yy";
                            });
  my $got = $history->signal_emit ('place-to-text', 'abc');
  ok ($to_text_called, 'place-to-text handler - called');
  is ($to_text_h, $history, 'place-to-text handler - history object arg');
  is ($got, "xx abc yy", 'place-to-text handler - result');
  is ($history->signal_emit ('place-to-text', $history),
      "xx $history yy",
      'place-to-text handler - 1,2');
}

#------------------------------------------------------------------------------
# weaken garbage collect

{
  my $history = Gtk2::Ex::History->new;
  require Scalar::Util;
  Scalar::Util::weaken ($history);
  is ($history, undef, 'weaken() garbage collect');
}

{
  my $history = Gtk2::Ex::History->new;
  my $back    = $history->model('back');
  my $forward = $history->model('forward');
  my $current = $history->model('current');
  require Scalar::Util;
  Scalar::Util::weaken ($history);
  Scalar::Util::weaken ($back);
  Scalar::Util::weaken ($forward);
  Scalar::Util::weaken ($current);
  is ($history, undef, 'weaken() history       garbage collect');
  is ($history, undef, 'weaken() back_model    garbage collect');
  is ($history, undef, 'weaken() forward_model garbage collect');
  is ($history, undef, 'weaken() current_model garbage collect');
}

exit 0;