The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More;

use t::tests qw( %runs );

plan tests => 28 + 15 * $runs{stats}{plan};

my $CLASS = 'Tree::Binary';
use_ok( $CLASS )
    or Test::More->builder->BAILOUT( "Cannot load $CLASS" );

my $root = $CLASS->new( 'root' );
isa_ok( $root, $CLASS );
isa_ok( $root, 'Tree' );

is( $root->root, $root, "The root's root is itself" );
is( $root->value, 'root', "value() works" );

$runs{stats}{func}->( $root,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

can_ok( $root, qw( left right ) );

my $left = $CLASS->new( 'left' );

$runs{stats}{func}->( $left,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

is( $root->left(), '', "Calling left with no params is a getter" );
is( $root->left( $left ), $root, "Calling left as a setter chains" );
is( $root->left(), $left, "... and set the left" );

cmp_ok( $root->children, '==', 1, "children() works" );
ok( $root->has_child( $left ), "has_child(BOOL) works on left" );
is_deeply( [ $root->get_index_for( $left ) ], [ 0 ], "get_index_for works on left" );

$runs{stats}{func}->( $root,
    height => 2, width => 1, depth => 0, size => 2, is_root => 1, is_leaf => 0,
);

$runs{stats}{func}->( $left,
    height => 1, width => 1, depth => 1, size => 1, is_root => 0, is_leaf => 1,
);

is( $root->left( undef ), $root, "Calling left with undef as a param" );
is( $root->left(), '', "... unsets left" );

cmp_ok( $root->children, '==', 0, "children() works" );

$runs{stats}{func}->( $root,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

$runs{stats}{func}->( $left,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

my $right = $CLASS->new( 'right' );

$runs{stats}{func}->( $right,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

is( $root->right(), '', "Calling right with no params is a getter" );
is( $root->right( $right ), $root, "Calling right as a setter chains" );
is( $root->right(), $right, "... and set the right" );

cmp_ok( $root->children, '==', 1, "children() works" );
ok( $root->has_child( $right ), "has_child(BOOL) works on right" );
is_deeply( [ $root->get_index_for( $right ) ], [ 1 ], "get_index_for works on right" );

$runs{stats}{func}->( $root,
    height => 2, width => 1, depth => 0, size => 2, is_root => 1, is_leaf => 0,
);

$runs{stats}{func}->( $right,
    height => 1, width => 1, depth => 1, size => 1, is_root => 0, is_leaf => 1,
);

is( $root->right( undef ), $root, "Calling right with undef as a param" );
is( $root->right(), '', "... unsets right" );

cmp_ok( $root->children, '==', 0, "children() works" );

$runs{stats}{func}->( $root,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

$runs{stats}{func}->( $right,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);

$root->left( $left );
$root->right( $right );

cmp_ok( $root->children, '==', 2, "children() works" );
ok( $root->has_child( $left ), "has_child(BOOL) works on right" );
ok( $root->has_child( $right ), "has_child(BOOL) works on right" );
ok( $root->has_child( $left, $right ), "has_child(SCALAR) works on right" );

$runs{stats}{func}->( $root,
    height => 2, width => 2, depth => 0, size => 3, is_root => 1, is_leaf => 0,
);
$runs{stats}{func}->( $left, height => 1, width => 1, depth => 1, size => 1, is_root => 0, is_leaf => 1,);

$runs{stats}{func}->( $right,
    height => 1, width => 1, depth => 1, size => 1, is_root => 0, is_leaf => 1,
);

my $right2 = $right->clone;
$runs{stats}{func}->( $right2,
    height => 1, width => 1, depth => 0, size => 1, is_root => 1, is_leaf => 1,
);