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