#!/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", ); } }