1%%
2%% %CopyrightBegin%
3%%
4%% Copyright Ericsson AB 1996-2016. All Rights Reserved.
5%%
6%% Licensed under the Apache License, Version 2.0 (the "License");
7%% you may not use this file except in compliance with the License.
8%% You may obtain a copy of the License at
9%%
10%%     http://www.apache.org/licenses/LICENSE-2.0
11%%
12%% Unless required by applicable law or agreed to in writing, software
13%% distributed under the License is distributed on an "AS IS" BASIS,
14%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
15%% See the License for the specific language governing permissions and
16%% limitations under the License.
17%%
18%% %CopyrightEnd%
19%%
20-module(digraph_SUITE).
21
22%%-define(STANDALONE,1).
23
24-ifdef(STANDALONE).
25-define(line, put(line, ?LINE), ).
26-else.
27-include_lib("common_test/include/ct.hrl").
28-endif.
29
30-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
31	 init_per_group/2,end_per_group/2]).
32
33-export([opts/1, degree/1, path/1, cycle/1, vertices/1,
34	 edges/1, data/1, otp_3522/1, otp_3630/1, otp_8066/1]).
35
36-export([spawn_graph/2]).
37
38%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
39
40suite() -> [{ct_hooks,[ts_install_cth]}].
41
42all() ->
43    [opts, degree, path, cycle, {group, misc},
44     {group, tickets}].
45
46groups() ->
47    [{misc, [], [vertices, edges, data]},
48     {tickets, [], [otp_3522, otp_3630, otp_8066]}].
49
50init_per_suite(Config) ->
51    Config.
52
53end_per_suite(_Config) ->
54    ok.
55
56init_per_group(_GroupName, Config) ->
57    Config.
58
59end_per_group(_GroupName, Config) ->
60    Config.
61
62
63%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
64
65opts(Config) when is_list(Config) ->
66    %% OTP-5985: the 'public' option has been removed
67    {'EXIT',{badarg,_}} = (catch digraph:new([public])),
68    {P2,G2} = spawn_graph([private]),
69    {'EXIT',{badarg,_}} = (catch digraph:add_vertex(G2, x)),
70    kill_graph(P2),
71    {P3,G3} = spawn_graph([protected]),
72    {'EXIT',{badarg,_}} = (catch digraph:add_vertex(G3, x)),
73    kill_graph(P3),
74    Template = [{v1,[v2]}, {v2,[v3]}, {v3,[v4]}, {v4,[]}],
75    G4 = build_graph([], Template),
76    e = digraph:add_edge(G4, e, v4, v1, []),
77    digraph:delete(G4),
78    G5 = build_graph([cyclic], Template),
79    e = digraph:add_edge(G5, e, v4, v1, []),
80    digraph:delete(G5),
81    G6 = build_graph([acyclic], Template),
82    acyclic = info(G6, cyclicity),
83    {error, {bad_edge,_}} = digraph:add_edge(G6, v4, v1),
84    digraph:delete(G6),
85    ok.
86
87
88%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
89
90degree(Config) when is_list(Config) ->
91    G = build_graph([], [{x1,[]}, {x2,[x1]}, {x3,[x1,x2]},
92			 {x4,[x1,x2,x3]}, {x5,[x1,x2,x3,x4]}]),
93    %% out degree
94    0 = digraph:out_degree(G, x1),
95    1 = digraph:out_degree(G, x2),
96    2 = digraph:out_degree(G, x3),
97    3 = digraph:out_degree(G, x4),
98    4 = digraph:out_degree(G, x5),
99    %% out neighbours
100    [] = check(digraph:out_neighbours(G, x1), []),
101    [] = check(digraph:out_neighbours(G, x2), [x1]),
102    [] = check(digraph:out_neighbours(G, x3), [x1,x2]),
103    [] = check(digraph:out_neighbours(G, x4), [x1,x2,x3]),
104    [] = check(digraph:out_neighbours(G, x5), [x1,x2,x3,x4]),
105
106    %% in degree
107    4 = digraph:in_degree(G, x1),
108    3 = digraph:in_degree(G, x2),
109    2 = digraph:in_degree(G, x3),
110    1 = digraph:in_degree(G, x4),
111    0 = digraph:in_degree(G, x5),
112    %% in neighbours
113    [] = check(digraph:in_neighbours(G, x1), [x2,x3,x4,x5]),
114    [] = check(digraph:in_neighbours(G, x2), [x3,x4,x5]),
115    [] = check(digraph:in_neighbours(G, x3), [x4,x5]),
116    [] = check(digraph:in_neighbours(G, x4), [x5]),
117    [] = check(digraph:in_neighbours(G, x5), []),
118    digraph:delete(G),
119    ok.
120
121%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
122
123path(Config) when is_list(Config) ->
124    G = build_graph([], [{x1,[x2,x3]}, {x2,[x4]}, {x3,[x4]},
125			 {x4,[x5,x6]}, {x5,[x7]}, {x6,[x7]}]),
126    Vi = case digraph:get_path(G, x1, x7) of
127	     [x1,x2,x4,x5,x7] -> digraph:del_vertex(G, x5), x6;
128	     [x1,x2,x4,x6,x7] -> digraph:del_vertex(G, x6), x5;
129	     [x1,x3,x4,x5,x7] -> digraph:del_vertex(G, x5), x6;
130	     [x1,x3,x4,x6,x7] -> digraph:del_vertex(G, x6), x5
131	 end,
132    Vj = case digraph:get_path(G, x1, x7) of
133	     [x1,x2,x4,Vi,x7] -> digraph:del_vertex(G,x2), x3;
134	     [x1,x3,x4,Vi,x7] -> digraph:del_vertex(G,x3), x2
135	 end,
136    [x1,Vj,x4,Vi,x7] = digraph:get_path(G, x1, x7),
137    digraph:del_vertex(G, Vj),
138    false = digraph:get_path(G, x1, x7),
139    [] = check(digraph:vertices(G), [x1,x4,Vi,x7]),
140    digraph:delete(G),
141    ok.
142
143%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
144
145cycle(Config) when is_list(Config) ->
146    G = build_graph([], [{x1,[x2,x3]}, {x2,[x4]}, {x3,[x4]},
147			 {x4,[x5,x6]}, {x5,[x7]}, {x6,[x7,x8]},
148			 {x8,[x3,x8]}]),
149    false = digraph:get_cycle(G, x1),
150    false = digraph:get_cycle(G, x2),
151    false = digraph:get_cycle(G, x5),
152    false = digraph:get_cycle(G, x7),
153    [x3,x4,x6,x8,x3] = digraph:get_cycle(G, x3),
154    [x4,x6,x8,x3,x4] = digraph:get_cycle(G, x4),
155    [x6,x8,x3,x4,x6] = digraph:get_cycle(G, x6),
156    [x8,x3,x4,x6,x8] = digraph:get_cycle(G, x8),
157    digraph:del_vertex(G, x4),
158    [x8] = digraph:get_cycle(G, x8),
159    digraph:delete(G),
160    ok.
161
162%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
163
164
165
166vertices(Config) when is_list(Config) ->
167    G = build_graph([], [{x,[]}, {y,[]}]),
168    [] = check(digraph:vertices(G), [x,y]),
169    digraph:del_vertices(G, [x,y]),
170    [] = digraph:vertices(G),
171    digraph:delete(G),
172    ok.
173
174edges(Config) when is_list(Config) ->
175    G = build_graph([], [{x, [{exy,y},{exx,x}]},
176			 {y, [{eyx,x}]}
177			]),
178    [] = check(digraph:edges(G), [exy, eyx, exx]),
179    [] = check(digraph:out_edges(G, x), [exy,exx]),
180    [] = check(digraph:in_edges(G, x), [eyx,exx]),
181    [] = check(digraph:out_edges(G, y), [eyx]),
182    [] = check(digraph:in_edges(G, y), [exy]),
183    true = digraph:del_edges(G, [exy, eyx, does_not_exist]),
184    [exx] = digraph:edges(G),
185    [] = check(digraph:out_edges(G, x), [exx]),
186    [] = check(digraph:in_edges(G, x), [exx]),
187    [] = check(digraph:out_edges(G, y), []),
188    [] = check(digraph:in_edges(G, y), []),
189    digraph:del_vertices(G, [x,y]),
190    [] = digraph:edges(G),
191    [] = digraph:vertices(G),
192    digraph:delete(G),
193    ok.
194
195data(Config) when is_list(Config) ->
196    G = build_graph([], [{x, [{exy, y}]}, {y, []}]),
197
198    {x,[]} = digraph:vertex(G, x),
199    {y,[]} = digraph:vertex(G, y),
200    {exy,x,y,[]} = digraph:edge(G, exy),
201
202    digraph:add_edge(G, exy, x, y, {data,x,y}),
203    E = digraph:add_edge(G, x, y, {data,y,x}),
204    digraph:add_vertex(G, x, {any}),
205    digraph:add_vertex(G, y, '_'),
206
207    {x,{any}} = digraph:vertex(G, x),
208    {y,'_'} = digraph:vertex(G, y),
209    {exy,x,y,{data,x,y}} = digraph:edge(G, exy),
210    {E,x,y,{data,y,x}} = digraph:edge(G, E),
211    true = digraph:del_edge(G, E),
212    false = digraph:edge(G, E),
213    true = sane(G),
214    digraph:delete(G),
215    ok.
216
217
218%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
219
220
221
222otp_3522(Config) when is_list(Config) ->
223    G1 = build_graph([acyclic], [{x, []}]),
224    {error, {bad_edge,_}} = digraph:add_edge(G1, x, x),
225    true = digraph:delete(G1),
226
227    G = digraph:new(),
228    0 = digraph:no_vertices(G),
229    0 = digraph:no_edges(G),
230    V1 = digraph:add_vertex(G),
231    '$vid' = digraph:add_vertex(G, '$vid'),
232    V2 = digraph:add_vertex(G),
233    '$eid' = digraph:add_edge(G, '$eid', V1, V2, []),
234    E = digraph:add_edge(G, V1, V2),
235    3 = digraph:no_vertices(G),
236    2 = digraph:no_edges(G),
237    cyclic = info(G, cyclicity),
238    protected = info(G, protection),
239
240    [] = check(digraph:in_edges(G, V2), ['$eid', E]),
241    [] = check(digraph:out_edges(G, V1), ['$eid', E]),
242    [] = check(digraph:vertices(G), [V1,V2,'$vid']),
243    [] = check(digraph:edges(G), [E, '$eid']),
244    true = sane(G),
245    true = digraph:delete(G),
246    ok.
247
248otp_3630(Config) when is_list(Config) ->
249    G = build_graph([], [{x, [{exy,y},{exx,x}]},
250			 {y, [{eyy,y},{eyx,x}]}
251			]),
252    [x,y] = digraph:get_path(G, x, y),
253    [y,x] = digraph:get_path(G, y, x),
254
255    [x,x] = digraph:get_short_path(G, x, x),
256    [y,y] = digraph:get_short_path(G, y, y),
257    true = digraph:delete(G),
258
259    G1 = build_graph([], [{1, [{12,2},{13,3},{11,1}]},
260			  {2, [{23,3}]},
261			  {3, [{34,4},{35,5}]},
262			  {4, [{45,5}]},
263			  {5, [{56,6},{57,7}]},
264			  {6, [{67,7}]},
265			  {7, [{71,1}]}
266			 ]),
267
268    [1,3,5,7] = digraph:get_short_path(G1, 1, 7),
269    [3,5,7,1,3] = digraph:get_short_cycle(G1, 3),
270    [1,1] = digraph:get_short_cycle(G1, 1),
271    true = digraph:delete(G1),
272
273    F = 0.0, I = round(F),
274    G2 = digraph:new([acyclic]),
275    digraph:add_vertex(G2, F),
276    digraph:add_vertex(G2, I),
277    E = digraph:add_edge(G2, F, I),
278    true = not is_tuple(E),
279    true = sane(G2),
280    true = digraph:delete(G2),
281
282    ok.
283
284otp_8066(Config) when is_list(Config) ->
285    fun() ->
286            D = digraph:new(),
287            V1 = digraph:add_vertex(D),
288            V2 = digraph:add_vertex(D),
289            _ = digraph:add_edge(D, V1, V2),
290            [V1, V2] = digraph:get_path(D, V1, V2),
291            true = sane(D),
292            true = digraph:del_path(D, V1, V2),
293            true = sane(D),
294            false = digraph:get_path(D, V1, V2),
295            true = digraph:del_path(D, V1, V2),
296            true = digraph:delete(D)
297    end(),
298
299    fun() ->
300            D = digraph:new(),
301            V1 = digraph:add_vertex(D),
302            V2 = digraph:add_vertex(D),
303            _ = digraph:add_edge(D, V1, V2),
304            _ = digraph:add_edge(D, V1, V2),
305            _ = digraph:add_edge(D, V1, V1),
306            _ = digraph:add_edge(D, V2, V2),
307            [V1, V2] = digraph:get_path(D, V1, V2),
308            true = sane(D),
309            true = digraph:del_path(D, V1, V2),
310            false = digraph:get_short_path(D, V2, V1),
311
312            true = sane(D),
313            false = digraph:get_path(D, V1, V2),
314            true = digraph:del_path(D, V1, V2),
315            true = digraph:delete(D)
316    end(),
317
318    fun() ->
319            G = digraph:new(),
320            W1 = digraph:add_vertex(G),
321            W2 = digraph:add_vertex(G),
322            W3 = digraph:add_vertex(G),
323            W4 = digraph:add_vertex(G),
324            _ = digraph:add_edge(G,['$e'|0], W1, W2, {}),
325            {error,{bad_vertex, bv}} =
326                digraph:add_edge(G, edge, bv, W1, {}),
327            {error,{bad_vertex, bv}} =
328                digraph:add_edge(G, edge, W1, bv, {}),
329            false = digraph:get_short_cycle(G, W1),
330            {error, {bad_edge,_}} =
331                digraph:add_edge(G,['$e'|0], W3, W4, {}),
332            true = sane(G),
333            true = digraph:delete(G)
334    end(),
335    ok.
336
337
338%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
339
340sane(G) ->
341    sane1(G),
342    erase(sane) =:= undefined.
343
344sane1(G) ->
345    %% etab: {E, V1, V2, Label}
346    %% ntab: {{out,V},E} eller {{in,V},E}
347    %% vtab: {V,Label}
348
349    Es = digraph:edges(G),
350    Vs = digraph:vertices(G),
351    VEs = lists:flatmap(fun(V) -> digraph:edges(G, V) end, Vs),
352    case lists:sort(Es++Es) =:= lists:sort(VEs) of
353        true -> ok;
354        false ->
355            io:format("Bad edges~n", []), put(sane, no)
356    end,
357
358    lists:foreach(
359      fun(E) ->
360              Edge = {E, V1, V2, _L} = digraph:edge(G, E),
361              case {digraph:vertex(G, V1), digraph:vertex(G, V2)} of
362                  {{V1, _}, {V2, _}} -> ok;
363                  _ -> io:format("Missing vertex ~p~n", [Edge]), put(sane, no)
364              end,
365              In = digraph:in_edges(G, V2),
366              case lists:member(E, In) of
367                  true -> ok;
368                  false ->
369                      io:format("Missing in-neighbour ~p~n", [Edge]),
370                      put(sane, no)
371              end,
372              Out = digraph:out_edges(G, V1),
373              case lists:member(E, Out) of
374                  true -> ok;
375                  false ->
376                      io:format("Missing out-neighbour ~p~n", [Edge]),
377                      put(sane, no)
378              end
379      end, Es),
380
381    lists:foreach(
382      fun(V) ->
383              InEs = digraph:in_edges(G, V),
384              %% *All* in-edoges of V
385              lists:foreach(
386                fun(E) ->
387                        case digraph:edge(G, E) of
388                            {E, _, V, _} -> ok;
389                            _ ->
390                                io:format("Bad in-edge ~p: ~p~n", [V, E]),
391                                put(sane, no)
392                        end
393                end, InEs),
394              OutEs = digraph:out_edges(G, V),
395              lists:foreach(
396                fun(E) ->
397                        case digraph:edge(G, E) of
398                            {E, V, _, _} -> ok;
399                            _ ->
400                                io:format("Bad out-edge ~p: ~p~n", [V, E]),
401                                put(sane, no)
402                        end
403                end, OutEs)
404      end, Vs),
405
406    InEs = lists:flatmap(fun(V) -> digraph:in_edges(G, V) end, Vs),
407    OutEs = lists:flatmap(fun(V) -> digraph:out_edges(G, V) end, Vs),
408    lists:foreach(
409      fun(E) ->
410              case digraph:edge(G, E) of
411                  {E, _, _, _} -> ok;
412                  _ ->
413                      io:format("Unknown edge (neighbour) ~p~n", [E]),
414                      put(sane, no)
415              end
416      end, InEs++OutEs),
417
418    N_in = length(InEs),
419    N_out = length(OutEs),
420    N_edges = digraph:no_edges(G),
421    if
422        N_in =/= N_out ->
423            io:format("Number of in- and out-edges differs~n", []),
424            put(sane, no);
425        N_in+N_out =/= N_edges+N_edges  ->
426            io:format("Invalid number of edges (~p+~p =/= 2*~p)~n",
427                      [N_in, N_out, N_edges]),
428            put(sane, no);
429        true -> ok
430    end,
431    Edges = [digraph:edge(G, E) || E <- Es],
432    EVs = lists:usort([V || {_, V, _, _} <- Edges] ++
433			  [V || {_, _, V, _} <- Edges]),
434    lists:foreach(
435      fun(V) ->
436              case digraph:vertex(G, V) of
437                  {_, _} -> ok;
438                  false ->
439                      io:format("Unknown vertex in edge: ~p~n", [V]),
440                      put(sane, no)
441              end
442      end, EVs),
443
444    %% sink_vertices and source_vertices were introduced in 2001. They
445    %% are not documented.
446
447    %% sink: a vertex with no outgoing edges
448    SinkVs = [V || V <- Vs, digraph:out_edges(G, V) =:= [] ],
449    case lists:sort(SinkVs) =:=  lists:sort(digraph:sink_vertices(G)) of
450        true -> ok;
451        false ->
452            io:format("Bad sinks~n"), put(sane, no)
453    end,
454    %% sink: a vertex with no incoming edges
455    SourceVs = [V || V <- Vs, digraph:in_edges(G, V) =:= [] ],
456    case lists:sort(SourceVs) =:=  lists:sort(digraph:source_vertices(G)) of
457        true -> ok;
458        false ->
459            io:format("Bad sources~n"), put(sane, no)
460    end,
461
462    true.
463
464build_graph(Opts, Gs) ->
465    G = digraph:new(Opts),
466    build_g(G, Gs).
467
468build_g(G, [{V,Ns} | Gs]) ->
469    digraph:add_vertex(G, V),
470    build_ns(G, V, Ns),
471    build_g(G, Gs);
472build_g(G, []) ->
473    true = sane(G),
474    G.
475
476build_ns(G, V, [{E,W} | Ns]) ->
477    digraph:add_vertex(G, W),
478    digraph:add_edge(G, E, V, W, []),
479    build_ns(G, V, Ns);
480build_ns(G, V, [W | Ns]) ->
481    digraph:add_vertex(G, W),
482    digraph:add_edge(G, V, W),
483    build_ns(G, V, Ns);
484build_ns(_G, _V, []) ->
485    true.
486
487%% Spawn a process that create a graph return {Pid, Graph}
488
489spawn_graph(Opts) ->
490    Pid = spawn(?MODULE, spawn_graph, [self(),Opts]),
491    receive
492	{Pid, G} -> {Pid,G}
493    end.
494
495%% Create a graph and wait for die message
496spawn_graph(Starter, Opts) ->
497    G = digraph:new(Opts),
498    Starter ! {self(), G},
499    receive
500	die -> true
501    end.
502
503info(G, What) ->
504    case lists:keysearch(What, 1, digraph:info(G)) of
505	{value, {What, Value}} -> Value;
506	false -> []
507    end.
508
509%% Kill process created by spawn_graph
510kill_graph(Pid) ->
511    Pid ! die.
512
513check(R0, E0) ->
514    R = lists:sort(R0),
515    E = lists:sort(E0),
516    case R of
517	E ->
518	    [];
519	_ ->
520	    (R -- E) ++ (E -- R)
521    end.
522