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'
  );

BEGIN { use_ok('dtRdr::TOC');   }
BEGIN { use_ok('dtRdr::Book::ThoutBook_1_0_jar');  }
BEGIN { use_ok('dtRdr::Range'); }

{ # first just fake it
  my $book = bless({}, 'dtRdr::Book');
  my $toc = do {
    my $range = dtRdr::Range->create(node => $book, range => [0,10]);
    dtRdr::TOC->new($book, 'foo', $range, {});
  };
  ok($toc);
  isa_ok($toc, 'dtRdr::TOC');

  # have this just to throw at evals
  my $arange = dtRdr::Range->create(node => $book, range => [0,10]);

  # try to misbehave
  eval { $toc->create_child('foo', $arange, {}) };
  ok($@, 'disallow duplicate id');

  # a child
  my $child0 = do {
    my $range = dtRdr::Range->create(node => $book, range => [0,7]);
    $toc->create_child('bar', $range, {});
  };
  ok($child0);
  isa_ok($child0, 'dtRdr::TOC');
  {
    my @children = $toc->children;
    is(scalar(@children), 1, 'count children');
    is($children[0], $child0, 'verify child');
  }

  # try to misbehave
  eval { $toc->create_child('bar', $arange, {}) };
  ok($@, 'disallow duplicate id');
  eval { $child0->create_child('bar', $arange, {}) };
  ok($@, 'disallow duplicate id');

  # another child
  my $child1 = do {
    my $range = dtRdr::Range->create(node => $book, range => [0,1]);
    $toc->create_child('baz', $range, {});
  };
  ok($child1);
  isa_ok($child1, 'dtRdr::TOC');
  {
    my @children = $toc->children;
    is(scalar(@children), 2, 'count children');
    is($children[0], $child0, 'verify child');
    is($children[1], $child1, 'verify child');
  }

  # try to misbehave
  eval { $child1->create_child('foo', $arange, {}) };
  ok($@, 'disallow duplicate id');
  eval { $child1->create_child('bar', $arange, {}) };
  ok($@, 'disallow duplicate id');
  eval { $child1->create_child('baz', $arange, {}) };
  ok($@, 'disallow duplicate id');

  # a child's child
  my $child1_0 = do {
    my $range = dtRdr::Range->create(node => $book, range => [0,1]);
    $child1->create_child('bip', $range, {});
  };
  ok($child1_0);
  isa_ok($child1_0, 'dtRdr::TOC');
  {
    my @children = $toc->children;
    is(scalar(@children), 2, 'count children');
    is($children[0], $child0, 'verify child');
    is($children[1], $child1, 'verify child');
  }
  {
    my @children = $child1->children;
    is(scalar(@children), 1, 'count children');
    is($children[0], $child1_0, 'verify child');
  }
  { # check the ancestors
    my @ancestors = $child1_0->ancestors;
    is(scalar(@ancestors), 2, 'count ancestors');
    is($ancestors[0], $child1, 'verify parent');
    is($ancestors[0], $child1_0->parent, 'verify parent');
    is($ancestors[1], $toc, 'verify parent');
    is($ancestors[1], $child1_0->root, 'verify parent');
    is($ancestors[-1], $child1_0->root, 'verify root');
  }
  { # get_by_id() checks
    # TODO should actually test each-to-each lookups here
    foreach my $node ($toc, $child0, $child1, $child1_0) {
      my $id = $node->id;
      my $found = $node->get_by_id($id);
      ok($found, "found something for '$id'");
      is($found->id, $id);
    }
  }

  ok(! $toc->validate_ranges, 'ranges not valid yet');
  ######################################################################

  # XXX our range/location objects are maybe too strict, but this is a rare test case
  # warn $child0->range->a;
  # warn $child0->range->b;
  $child0->{range} = dtRdr::Range->create(node => $book, range => [1,3]);
  $child1->{range} = dtRdr::Range->create(node => $book, range => [4,9]);
  $child1_0->{range} = dtRdr::Range->create(node => $book, range => [5,9]);

  ok($toc->validate_ranges, 'ranges valid');
  ######################################################################

  $child1_0->{range} = dtRdr::Range->create(node => $book, range => [4,9]);

  ok($toc->validate_ranges, 'ranges valid');
  ######################################################################

  my $child1_0_0 = $child1_0->create_child('bop',
    dtRdr::Range->create(node => $book, range => [0,1]), {}
    );

  { # descendants
    my @descendants = $child1->descendants;
    is(scalar(@descendants), 2, 'descendant count');
    is($descendants[0], $child1_0, 'verify descendant');
    is($descendants[1], $child1_0_0, 'verify descendant');
  }

  { # older siblings
    my @sib = $child0->older_siblings;
    is(scalar(@sib), 0, 'no older siblings');
  }
  { # older siblings
    my @sib = $child1->older_siblings;
    is(scalar(@sib), 1, 'one older sibling');
  }
  my $child2 = $toc->create_child('doh', # running out of names here
    dtRdr::Range->create(node => $book, range => [9,10]), {}
    );
  { # older siblings
    my @sib = $child2->older_siblings;
    is(scalar(@sib), 2, 'two older siblings');
  }
}