1use Graph; 2 3use Test::More tests => 37; 4 5print "# creating graph\n"; 6my $gr = Graph->new( multiedged => 1 ); 7 8my $A = { name => 'A' }; 9my $B = { name => 'B' }; 10my $C = { name => 'C' }; 11 12print "# adding A => B\n"; 13add_edge ($gr,$A,$B); 14dumper2($gr); 15 16my @ids; 17 18is($gr->successors ('A'), 1); 19is($gr->predecessors('A'), 0); 20 21@ids = sort $gr->get_multiedge_ids('A', 'B'); 22is(@ids, 1); 23is("@ids", "0"); 24 25is($gr->successors ('B'), 0); 26is($gr->predecessors('B'), 1); 27 28@ids = sort $gr->get_multiedge_ids('A', 'B'); 29is(@ids, 1); 30is("@ids", "0"); 31 32@ids = sort $gr->get_multiedge_ids('B', 'C'); 33is(@ids, 0); 34is("@ids", ""); 35 36print "# adding C => B\n"; 37add_edge( $gr, $C, $B ); 38dumper2($gr); 39 40is($gr->successors ('A'), 1); 41is($gr->predecessors('A'), 0); 42 43@ids = sort $gr->get_multiedge_ids('A', 'B'); 44is(@ids, 1); 45is("@ids", "0"); 46 47is($gr->successors ('B'), 0); 48is($gr->predecessors('B'), 2); 49 50@ids = sort $gr->get_multiedge_ids('A', 'B'); 51is(@ids, 1); 52is("@ids", "0"); 53 54@ids = sort $gr->get_multiedge_ids('C', 'B'); 55is(@ids, 1); 56is("@ids", "0"); 57 58is($gr->successors ('C'), 1); 59is($gr->predecessors('C'), 0); 60 61@ids = sort $gr->get_multiedge_ids('C', 'B'); 62is(@ids, 1); 63is("@ids", "0"); 64 65@ids = sort $gr->get_multiedge_ids('B', 'C'); 66is(@ids, 0); 67is("@ids", ""); 68 69sub add_edge 70 { 71 my ($g,$x,$y) = @_; 72 73 my $edge_id = $g->add_edge_get_id($x->{name}, $y->{name}); 74 75 # work around bug in Graph v0.65 returning something else instead of '0' 76 # on first call 77 $edge_id = '0' if ref($edge_id); 78 79 # comment this line out, and the dump changes 80 $g->set_edge_attribute_by_id( $x->{name}, $y->{name}, $edge_id, "OBJ", {}); 81 82 } 83 84sub dumper2 85 { 86 my @nodes = $gr->vertices(); 87 for my $n (sort @nodes) 88 { 89 print "# $n:\n"; 90 print "# successors : ", scalar $gr->successors($n),"\n"; 91 print "# predecessors : ", scalar $gr->predecessors($n),"\n"; 92 my @suc = $gr->successors($n); 93 for my $s (@suc) 94 { 95 print "# multiedge_ids $n => $s: ", join (", ", $gr->get_multiedge_ids($n, $s)),"\n"; 96 } 97 my @pre = $gr->predecessors($n); 98 for my $p (@pre) 99 { 100 print "# multiedge_ids $p => $n: ", join (", ", $gr->get_multiedge_ids($p, $n)),"\n"; 101 } 102 } 103 } 104 105{ 106 my $graph = Graph->new( undirected => 1 ); 107 108 $graph->add_vertex("Berlin"); 109 $graph->add_vertex("Bonn"); 110 $graph->add_edge("Berlin","Bonn"); 111 is ("$graph","Berlin=Bonn"); 112 $graph->set_edge_attributes("Berlin", "Bonn", { color => "red" }); 113 is($graph->get_edge_attribute("Bonn", "Berlin", "color"), "red"); 114 is($graph->get_edge_attribute("Berlin", "Bonn", "color"), "red"); 115 is ("$graph","Berlin=Bonn"); 116 117 $graph = Graph->new( undirected => 1 ); 118 119 #$graph->add_vertex("Berlin"); 120 #$graph->add_vertex("Bonn"); 121 $graph->add_edge("Bonn","Berlin"); 122 is ("$graph","Berlin=Bonn"); 123 $graph->set_edge_attributes("Bonn", "Berlin", { color => "red" }); 124 is($graph->get_edge_attribute("Bonn", "Berlin", "color"), "red"); 125 is($graph->get_edge_attribute("Berlin", "Bonn", "color"), "red"); 126 is ("$graph","Berlin=Bonn"); 127} 128 129{ 130 my $graph = Graph->new( multiedged => 1, undirected => 1 ); 131 132 isnt ($graph->multiedged(), 0, 'is multiedged'); 133 134 my $from = 'Berlin'; my $to = 'Bonn'; 135 136 my $id = $graph->add_edge_get_id($from, $to); 137 is ("$graph", "Berlin=Bonn", 'only one edge'); 138 139 $graph->set_edge_attributes_by_id($from, $to, $id, { color => 'silver' } ); 140 141 is ("$graph", "Berlin=Bonn", 'only one edge'); 142} 143 144