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 tests => 20;
use Test::Deep;

use Scalar::Util qw( refaddr );

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

my $tree = $CLASS->new( 'foo' );
my $clone = $tree->clone;

isa_ok( $clone, $CLASS );
isnt( refaddr($clone), refaddr($tree), "The clone is a different reference from the tree" );
cmp_deeply( $clone, $tree, "The clone has all the same info as the tree" );

$tree->set_value( 'bar' );

ok( !eq_deeply( $clone, $tree ), "The tree changed, but the clone didn't track" );

$tree->set_value( 'foo' );

cmp_deeply( $clone, $tree, "The tree changed back, so they're equivalent" );

my $child = $CLASS->new;
$tree->add_child( $child );

ok( !eq_deeply( $clone, $tree ), "The tree added a child, but the clone didn't track" );

my $clone2 = $tree->clone;

cmp_deeply( $clone2, $tree, "Cloning with children works" );
my $cloned_child = $clone->children(0);
isnt( refaddr($cloned_child), refaddr($child), "The cloned child is a different reference from the child" );

my $grandchild = $CLASS->new;
$child->add_child( $grandchild );

my $clone3 = $tree->clone;
cmp_deeply( $clone3, $tree, "Cloning with grandchildren works" );

my $clone4 = $child->clone;
ok( !eq_deeply( $clone4, $child ), "Even though the child is cloned, the parentage is not" );
ok( $clone4->is_root, "... all clones are roots" );

my $clone5 = $CLASS->clone;
isa_ok( $clone5, $CLASS );

my $tree2 = $CLASS->new('foo');
my $clone6 = $tree2->clone('bar');

ok(!eq_deeply( $clone6, $tree2 ), "By passing a value into clone(), it sets the value of the clone" );
is( $clone6->value, 'bar', "The clone's value should be 'bar'" );
is( $tree2->value, 'foo', "... but the tree's value should still be 'foo'" );

my $clone7 = $tree2->new;
cmp_deeply( $clone, $tree2, "Calling new() with an object wraps clone()" );

my $clone8 = $tree2->new( 'bar' );
ok(!eq_deeply( $clone8, $tree2 ), "By passing a value into an object calling new(), it sets the value of the clone" );
is( $clone8->value, 'bar', "The clone's value should be 'bar'" );
is( $tree2->value, 'foo', "... but the tree's value should still be 'foo'" );