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

# vim:ts=2:sw=2:et:sta:syntax=perl

use strict;
use warnings;

use Test::More (
  'no_plan'
  );

use constant {
  class => 'List::History',
};

BEGIN { use_ok('List::History') };

# check the alias definitions
ok(class->can('list'),              'list() accessor');
ok(class->can('get_list'),          'get_list() accessor');
ok((
  class->can('list') eq
  class->can('get_list')
  ),                                'alias list() to get_list()'
);
#ok(class->can('set_list'),          'set_list() mutator');

ok(class->can('current'),           'current() accessor');
ok(class->can('get_current'),       'get_current() accessor');
ok((not class->can('set_current')), 'no set_current() mutator');
ok((
  class->can('current') eq
  class->can('get_current')
  ),                                'alias current() to get_current()'
);

ok(class->can('current_pos'),       'current_pos() accessor');
ok(class->can('get_current_pos'),   'get_current_pos() accessor');
ok((
  class->can('current_pos') eq
  class->can('get_current_pos')
  ),                                'alias current_pos() to get_current_pos()'
);
ok(class->can('set_current_pos'),   'set_current_pos() mutator');

foreach my $group (
  [qw(f fore foreward)],
  [qw(b back backward)],
  ) {
  my (@alias) = @$group[0,1];
  my ($method) = $group->[2];
  foreach my $m (@$group) {
    ok(class->can($m),              "$m() accessor");
  }
  foreach my $al (@alias) {
    ok((
      class->can($al) eq
      class->can($method)
      ),                            "alias $al() to $method"
    );
  }
}

foreach my $method (qw(
  new
  add
  remember
  has_current
  has_next
  has_prev
  get_moment
  clear_future
  )) {
  ok(class->can($method),           "$method() method");
}

my %mspec = (
  day => 1,
  hour => 1,
  dog => 'fido',
  );
my $hist = List::History->new(moment_spec => \%mspec);
ok($hist,                           'constructor');
isa_ok($hist, class,                'isa '. class);

# we use this later
my $gen_class = "$hist"; $gen_class =~ s/.*=(.*)/$1-moment/;

{
  # check the generated moment class
  ok($gen_class->can('new'), 'can new');
  my $moment = $hist->moment(day => 1, hour => 2, dog => 'spike');
  isa_ok($moment, $gen_class);
  foreach my $key (keys(%mspec)) {
    ok($moment->can($key),       "can $key");
    ok($moment->can("get_$key"), "can get_$key");
    ok($moment->can("set_$key"), "can set_$key");
  }
  is($moment->get_day, 1, 'day');
  is($moment->day, 1, 'day');
  eval { $moment->set_day(2) };
  ok(! $@);
  is($moment->day, 2, 'day set');
}

{
my @list = $hist->get_list;
ok(@list == 0,                      'got empty list');
}
{
my $has = $hist->has_current;
ok((not $has),                      'no current moment at new');
}
{
my $has = $hist->has_prev;
ok((not $has),                      'no previous moment at new');
}
{
my $has = $hist->has_next;
ok((not $has),                      'no next moment at new');
}

# add a moment
my $moment1 = $hist->add();
isa_ok($moment1, $gen_class,        'made a moment');
{
my $has = $hist->has_current;
ok((not $has),                      'no current moment at add');
}
{
my $has = $hist->has_prev;
ok($has,                            'has previous at add');
}
{
my $has = $hist->has_next;
ok((not $has),                      'no next moment at add');
}

# remember a moment
my $moment2 = $hist->remember(scroll_pos => 7);
isa_ok($moment2, $gen_class,        'made a moment');
{
my $has = $hist->has_current;
ok($has,                            'has current moment at remember');
}
{
my $has = $hist->has_prev;
ok($has,                            'has previous at remember');
}
{
my $has = $hist->has_next;
ok((not $has),                      'no next moment at remember');
}

# go back
{
my $moment = $hist->back;
isa_ok($moment, $gen_class,         'retrieved a moment');
ok($moment eq $moment1,             'matches the original');
}

{
my $has = $hist->has_current;
ok($has,                            'has current moment at back');
}
{
my $has = $hist->has_prev;
ok((not $has),                      'no previous at back');
}
{
my $has = $hist->has_next;
ok($has,                            'has next moment at back');
}
{
my @list = $hist->get_list;
ok(@list == 2,                      'got 2-item list');
}
# XXX I'm considering making this a private method now
# $hist->clear_future;
# {
# my @list = $hist->get_list;
# ok(@list == 1,                      'got 1-item list');
# my $has = $hist->has_next;
# ok((not $has),                      'no next moment after clear_future');
# }