The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use Test::More tests => 96;

use Graph::Directed;
use Graph::Undirected;

my $g0 = Graph::Directed->new;
my $g1 = Graph::Undirected->new;
my $g2 = Graph::Directed->new;
my $g3 = Graph::Undirected->new;
my $g4 = Graph::Directed->new;
my $g5 = Graph::Undirected->new;

$g0->add_path(qw(a b c));
$g0->add_path(qw(d b e));

$g1->add_path(qw(a b c));
$g1->add_path(qw(d b e));

$g2->add_path(qw(a b c d));
$g2->add_path(qw(c a));

$g3->add_path(qw(a b c d));
$g3->add_path(qw(c a));

$g4->add_path(qw(a b c));
$g4->add_path(qw(b a));

$g5->add_path(qw(a b c));
$g5->add_path(qw(b a));

my $g0c = $g0->copy;
my $g1c = $g1->copy;
my $g2c = $g2->copy;
my $g3c = $g3->copy;
my $g4c = $g4->copy;
my $g5c = $g5->copy;

is("@{[sort $g0c->successors('a')]}", "b");
is("@{[sort $g0c->successors('b')]}", "c e");
is("@{[sort $g0c->successors('c')]}", "");
is("@{[sort $g0c->successors('d')]}", "b");
is("@{[sort $g0c->successors('e')]}", "");

is("@{[sort $g0c->predecessors('a')]}", "");
is("@{[sort $g0c->predecessors('b')]}", "a d");
is("@{[sort $g0c->predecessors('c')]}", "b");
is("@{[sort $g0c->predecessors('d')]}", "");
is("@{[sort $g0c->predecessors('e')]}", "b");

is("@{[sort $g1c->successors('a')]}", "b");
is("@{[sort $g1c->successors('b')]}", "a c d e");
is("@{[sort $g1c->successors('c')]}", "b");
is("@{[sort $g1c->successors('d')]}", "b");
is("@{[sort $g1c->successors('e')]}", "b");

is("@{[sort $g1c->predecessors('a')]}", "b");
is("@{[sort $g1c->predecessors('b')]}", "a c d e");
is("@{[sort $g1c->predecessors('c')]}", "b");
is("@{[sort $g1c->predecessors('d')]}", "b");
is("@{[sort $g1c->predecessors('e')]}", "b");

is("@{[sort $g2c->successors('a')]}", "b");
is("@{[sort $g2c->successors('b')]}", "c");
is("@{[sort $g2c->successors('c')]}", "a d");
is("@{[sort $g2c->successors('d')]}", "");

is("@{[sort $g2c->predecessors('a')]}", "c");
is("@{[sort $g2c->predecessors('b')]}", "a");
is("@{[sort $g2c->predecessors('c')]}", "b");
is("@{[sort $g2c->predecessors('d')]}", "c");

is("@{[sort $g3c->successors('a')]}", "b c");
is("@{[sort $g3c->successors('b')]}", "a c");
is("@{[sort $g3c->successors('c')]}", "a b d");
is("@{[sort $g3c->successors('d')]}", "c");

is("@{[sort $g3c->predecessors('a')]}", "b c");
is("@{[sort $g3c->predecessors('b')]}", "a c");
is("@{[sort $g3c->predecessors('c')]}", "a b d");
is("@{[sort $g3c->predecessors('d')]}", "c");

is("@{[sort $g4c->successors('a')]}", "b");
is("@{[sort $g4c->successors('b')]}", "a c");
is("@{[sort $g4c->successors('c')]}", "");

is("@{[sort $g4c->predecessors('a')]}", "b");
is("@{[sort $g4c->predecessors('b')]}", "a");
is("@{[sort $g4c->predecessors('c')]}", "b");

is("@{[sort $g5c->successors('a')]}", "b");
is("@{[sort $g5c->successors('b')]}", "a c");
is("@{[sort $g5c->successors('c')]}", "b");

is("@{[sort $g5c->predecessors('a')]}", "b");
is("@{[sort $g5c->predecessors('b')]}", "a c");
is("@{[sort $g5c->predecessors('c')]}", "b");

my $g0u = $g0->undirected_copy;
my $g2u = $g2->undirected_copy;
my $g4u = $g4->undirected_copy;

is($g0u, $g1);
is($g2u, $g3);
is($g4u, $g5);

my $g1d = $g1->directed_copy;
my $g3d = $g3->directed_copy;
my $g5d = $g5->directed_copy;

for my $i ([$g1d, $g1],
	   [$g3d, $g3],
	   [$g5d, $g5]) {
    my ($d, $u) = @$i;
    for my $e ($u->edges) {
	my @e = @$e;
	ok($d->has_edge(@e));
	ok($d->has_edge(reverse @e));
    }
    for my $v ($u->vertices) {
	ok($d->has_vertex($v));
    }
}

{
    my $g = Graph->new;
    $g->set_graph_attribute('color' => 'deep_purple');
    $g->set_graph_attribute('hunky' => sub { "hunky $_[0]" });
 SKIP: {
	skip("no coderef Deparse", 2) unless $] >= 5.008;
	my $c = $g->deep_copy;
	is($c->get_graph_attribute('color'), 'deep_purple');
	is($c->get_graph_attribute('hunky')->('dory'), 'hunky dory');
    }
}

SKIP: {
    skip("no coderef Deparse", 1) unless $] >= 5.008;
    my $g = Graph->new;
    $g->set_graph_attribute('color' => sub { $_[0] ** 2 });
    my $c = $g->deep_copy;
    is($c->get_graph_attribute('color')->(7), 49);
}

SKIP: {
    skip("no coderef Deparse", 1) unless $] >= 5.008;
    skip("no coderef Deparse with Storable", 1)
	unless Graph::_can_deep_copy_Storable();
    require Storable;
    my $g = Graph->new;
    $g->set_graph_attribute('color' => sub { $_[0] ** 3 });
    my $c = $g->_deep_copy_Storable;
    is($c->get_graph_attribute('color')->(2), 8);
}

SKIP: {
    skip("no coderef Deparse", 1) unless $] >= 5.008;
    my $g = Graph->new;
    $g->set_graph_attribute('color' => sub { $_[0] ** 4 });
    my $c = $g->_deep_copy_DataDumper;
    is($c->get_graph_attribute('color')->(3), 81);
}

for my $a (qw(refvertexed
	      hypervertexed
	      countvertexed
	      multivertexed
	      hyperedged
	      countedged
	      multiedged
	      omniedged)) {
    my $g = Graph->new($a => 1);
    my $c = $g->copy;
    ok($c->$a);
}