The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w

# Copyright 2010, 2011 Kevin Ryde

# This file is part of Gtk2-Ex-History.
#
# Gtk2-Ex-History is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by the
# Free Software Foundation; either version 3, or (at your option) any later
# version.
#
# Gtk2-Ex-History is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License along
# with Gtk2-Ex-History.  If not, see <http://www.gnu.org/licenses/>.

use 5.008;
use strict;
use warnings;
use Test::More tests => 29;

use lib 't';
use MyTestHelpers;
BEGIN { MyTestHelpers::nowarnings() }

require Gtk2::Ex::History;


#-----------------------------------------------------------------------------
my $want_version = 8;
is ($Gtk2::Ex::History::VERSION, $want_version, 'VERSION variable');
is (Gtk2::Ex::History->VERSION,  $want_version, 'VERSION class method');
{ ok (eval { Gtk2::Ex::History->VERSION($want_version); 1 },
      "VERSION class check $want_version");
  my $check_version = $want_version + 1000;
  ok (! eval { Gtk2::Ex::History->VERSION($check_version); 1 },
      "VERSION class check $check_version");
}

#------------------------------------------------------------------------------
# new()

{
  my $history = Gtk2::Ex::History->new;
  isa_ok ($history, 'Gtk2::Ex::History');

  is ($history->VERSION, $want_version, 'VERSION object method');
  ok (eval { $history->VERSION($want_version); 1 },
      "VERSION object check $want_version");
  ok (! eval { $history->VERSION($want_version + 1000); 1 },
      "VERSION object check " . ($want_version + 1000));
}

#------------------------------------------------------------------------------
# _default_place_equal()

{
  my $history = Gtk2::Ex::History->new;
  ok (  $history->signal_emit ('place-equal', 'abc', 'abc'));
  ok (! $history->signal_emit ('place-equal', 'abc', 'def'));
  ok (  $history->signal_emit ('place-equal', undef, undef));
  ok (! $history->signal_emit ('place-equal', 'abc', undef));
  ok (! $history->signal_emit ('place-equal', undef, 'abc'));
}

#------------------------------------------------------------------------------
# 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;