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

# Test case : entire branch is deleted instead of single node only
#
# Copyright (C) Karl Kästner - Berlin, Germany
# Sun Apr  5 07:24:11 MSD 2009

use strict;
use warnings;

use Test::More tests => 3;

BEGIN {
    use_ok('Tree::Binary'); use_ok('Tree::Binary::Search');
}

# ------------------------------------------------

my @nodes = (
		 [ "L", "K", "P", "Q" ]
		,[ "L", "K", "P", "N", "Q" ]
		,[ "L", "K", "P", "N", "M", "Q" ]
		,[ "L", "K", "P", "N", "O", "Q" ]
		,[ "L", "K", "P", "N", "M", "O", "Q" ]
	);
my($expected) = <<'EOS';
K L P Q        -- 4 3 --  K P Q
K L N P Q      -- 5 4 --  K N P Q
K L M N P Q    -- 6 5 --  K M N P Q
K L N O P Q    -- 6 5 --  K N O P Q
K L M N O P Q  -- 7 6 --  K M N O P Q
EOS

my(@output);

foreach ( @nodes )
{
	push @output, test( "L", @{$_} );
}

ok(join('', split(/\n/, $expected) ) eq join('', @output), 'Node deletion works in V 1.00');

sub test
{
	my @nodes = @_;
	my $delNode = shift(@nodes);

	my $tree = Tree::Binary::Search->new();
	$tree->useStringComparison();

	foreach ( @nodes )
	{
		$tree->insert($_, $_);
	}

	my($output) = '';

	warn "search order inconsistent\n" if
		verify(\$output, Tree::Binary::Search::getTree($tree));

	my $size_1 = $tree->size();
	$tree->delete($delNode);
	my $size_2 = $tree->size();
	$output .= ' ' x (15 - length($output) ) . "-- $size_1 $size_2 --  ";

	warn "Number of elements incorrect\n"
		if ($size_2 + 1 != $size_1);
	warn "search order inconsistent\n" if
		verify(\$output, Tree::Binary::Search::getTree($tree));

	$output =~ s/\s$//;

	return $output;

} # test

sub verify
{
	my($output, $tree) = @_;
	my @value = _verify($output, $tree );
	my $retval = 0;

	while ( @value >= 2 )
	{
        	if ( ( $value[0] cmp $value[1] ) > 0)
		{
			$retval = -1;
		}
		$$output .= shift(@value)." ";
	}
	$$output .= shift(@value);

	return $retval;

} # verify

sub _verify
{
	my($output, $self) = @_;

	if (defined $self)
	{
		my $value = $self->getNodeValue();
		_verify($output, $self->getLeft);
		$$output .= $value." ";
		_verify($output, $self->getRight);
	}

} # _verify