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

# Creating and using dependency trees

use strict;
use warnings;

use Test::More tests => 49;
use Test::Deep;

{
	package SomeObj;
	use Scalar::Util qw/refaddr/;

	use overload '""' => 'id', fallback => 1;

	my $id = 'A';
	my %id;
	
	sub id { $id{refaddr $_[0]} }
	sub new {
		my $pkg = shift;
		my $self = bless [ @_ ], $pkg;
		$id{refaddr $self} = $id++;
		$self;
	}
	sub depends {
		@{ $_[0] }
	}
}

use Set::Object;

my $objs = Set::Object->new(my ($a,$b,$c,$d,$e,$f) = map { SomeObj->new() } qw/A B C D E F/);
@$b = ($c);
@$d = ($e, $f);

my $m;
BEGIN { use_ok($m = "Algorithm::Dependency::Objects") };

# Load the data/basics.txt file in as a source file, and test it rigorously.

{
	# Try to create a basic unordered dependency
	isa_ok(my $dep = $m->new(objects => $objs), $m);

	is($dep->objects->size, 6, "six objects are registered");
	is($dep->selected->size, 0, "no objects are selected");

	verify_dep_and_sched($dep, [
		[$a],		[],				[$a] 			], [
		[$b],		[$c],			[$b, $c] 		], [
		[$c],		[], 			[$c]			], [
		[$d],		[$e, $f],		[$d, $e, $f]	], [
		[$e],		[],				[$e]			], [
		[$f],		[],				[$f]			], [
		[$a, $b],	[$c],			[$a, $b, $c]	], [
		[$b, $d],	[$c, $e, $f],	[$b, $c, $d, $e, $f]		]
	);
}


{
	# Create with one selected
	isa_ok(my $dep = $m->new( objects => $objs, selected => Set::Object->new($f) ), $m);

	cmp_deeply(
		[ $dep->schedule_all ],
		bag( $a, $b, $c, $d, $e ),  # no $f
		"schedule_all",
	);

	is($dep->objects->size, 6, "six objects registered" );
	is($dep->selected->size, 1, "one objects selected" );

	ok( !$dep->selected->contains($a), "a is not selected" );
	ok( $dep->selected->contains($f), "f is selected" );

	verify_dep_and_sched($dep, [
		[$a],		[],				[$a] 			], [
		[$b],		[$c],			[$b, $c] 		], [
		[$c],		[], 			[$c]			], [
		[$d],		[$e],			[$d, $e]		], [
		[$e],		[],				[$e]			], [
		[$f],		[],				[]				], [
		[$a, $b],	[$c],			[$a, $b, $c]	], [
		[$b, $d],	[$c, $e],	[$b, $c, $d, $e]	]
	);
}

sub verify_dep_and_sched {
	my $dep = shift;

	foreach my $data (@_){
		my $args = join( ', ', @{ $data->[0] } );
		my @deps = $dep->depends( @{ $data->[0] } );
		cmp_deeply(\@deps, bag(@{ $data->[1] }), "depends($args)" );
		my @sched = $dep->schedule( @{ $data->[0] } );
		cmp_deeply(\@sched, bag(@{ $data->[2] }), "schedule($args)" );
	}
}

BEGIN { use_ok("Algorithm::Dependency::Objects::Ordered") }

{
	my @objs = map { SomeObj->new } qw/G H I J K L M N O P/;
	
	@{ $objs[0] } = @objs[4, 5];

	@{ $objs[4] } = @objs[5, 2];

	@{ $objs[2] } = @objs[5, 7];

	@{ $objs[5] } = ( $objs[7] );

	@{ $objs[7] } = @objs[9, 8];

	@{ $objs[9] } = ( $objs[8] );

	{
		my $d = Algorithm::Dependency::Objects->new(
			objects => \@objs,
		);

		cmp_deeply( [ $d->schedule($objs[9]) ], bag(@objs[8,9]), "unordered dep" );
		cmp_deeply( [ $d->schedule($objs[2]) ], bag(@objs[2, 5, 7, 9, 8]), "unordered dep" );
		cmp_deeply( [ $d->schedule_all ], bag(@objs), "unordered dep" );
	}

	{
		my $d = Algorithm::Dependency::Objects::Ordered->new(
			objects => \@objs,
		);

		is_deeply(
			[ $d->schedule($objs[9]) ],
			[ @objs[8,9] ],
			"simple schedule",
		);

		is_deeply(
			[ $d->schedule($objs[2]) ],
			[ @objs[8, 9, 7, 5, 2 ] ],
			"complex schedule",
		);

		is_deeply(
			[ $d->schedule($objs[0]) ],
			[ @objs[8, 9, 7, 5, 2, 4, 0] ],
			"complex schedule",
		);
	}
}