From: Hristian Kirtchev Date: Mon, 1 Jul 2019 13:35:15 +0000 (+0000) Subject: [Ada] Clean up of GNAT.Graphs X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=63059bf096cde85fc585455b26b94c2fdc806bac;p=gcc.git [Ada] Clean up of GNAT.Graphs ------------ -- Source -- ------------ -- operations.adb with Ada.Text_IO; use Ada.Text_IO; with GNAT; use GNAT; with GNAT.Graphs; use GNAT.Graphs; with GNAT.Sets; use GNAT.Sets; procedure Operations is type Vertex_Id is (No_V, VA, VB, VC, VD, VE, VF, VG, VH, VX, VY, VZ); No_Vertex_Id : constant Vertex_Id := No_V; function Hash_Vertex (V : Vertex_Id) return Bucket_Range_Type; type Edge_Id is (No_E, E1, E2, E3, E4, E5, E6, E7, E8, E9, E10, E97, E98, E99); No_Edge_Id : constant Edge_Id := No_E; function Hash_Edge (E : Edge_Id) return Bucket_Range_Type; package ES is new Membership_Sets (Element_Type => Edge_Id, "=" => "=", Hash => Hash_Edge); package DG is new Directed_Graphs (Vertex_Id => Vertex_Id, No_Vertex => No_Vertex_Id, Hash_Vertex => Hash_Vertex, Same_Vertex => "=", Edge_Id => Edge_Id, No_Edge => No_Edge_Id, Hash_Edge => Hash_Edge, Same_Edge => "="); use DG; package VS is new Membership_Sets (Element_Type => Vertex_Id, "=" => "=", Hash => Hash_Vertex); ----------------------- -- Local subprograms -- ----------------------- procedure Check_Belongs_To_Component (R : String; G : Directed_Graph; V : Vertex_Id; Exp_Comp : Component_Id); -- Verify that vertex V of graph G belongs to component Exp_Comp. R is the -- calling routine. procedure Check_Belongs_To_Some_Component (R : String; G : Directed_Graph; V : Vertex_Id); -- Verify that vertex V of graph G belongs to some component. R is the -- calling routine. procedure Check_Destination_Vertex (R : String; G : Directed_Graph; E : Edge_Id; Exp_V : Vertex_Id); -- Vertify that the destination vertex of edge E of grah G is Exp_V. R is -- the calling routine. procedure Check_Distinct_Components (R : String; Comp_1 : Component_Id; Comp_2 : Component_Id); -- Verify that components Comp_1 and Comp_2 are distinct (not the same) procedure Check_Has_Component (R : String; G : Directed_Graph; G_Name : String; Comp : Component_Id); -- Verify that graph G with name G_Name contains component Comp. R is the -- calling routine. procedure Check_Has_Edge (R : String; G : Directed_Graph; E : Edge_Id); -- Verify that graph G contains edge E. R is the calling routine. procedure Check_Has_Vertex (R : String; G : Directed_Graph; V : Vertex_Id); -- Verify that graph G contains vertex V. R is the calling routine. procedure Check_No_Component (R : String; G : Directed_Graph; V : Vertex_Id); -- Verify that vertex V does not belong to some component. R is the calling -- routine. procedure Check_No_Component (R : String; G : Directed_Graph; G_Name : String; Comp : Component_Id); -- Verify that graph G with name G_Name does not contain component Comp. R -- is the calling routine. procedure Check_No_Edge (R : String; G : Directed_Graph; E : Edge_Id); -- Verify that graph G does not contain edge E. R is the calling routine. procedure Check_No_Vertex (R : String; G : Directed_Graph; V : Vertex_Id); -- Verify that graph G does not contain vertex V. R is the calling routine. procedure Check_Number_Of_Components (R : String; G : Directed_Graph; Exp_Num : Natural); -- Verify that graph G has exactly Exp_Num components. R is the calling -- routine. procedure Check_Number_Of_Edges (R : String; G : Directed_Graph; Exp_Num : Natural); -- Verify that graph G has exactly Exp_Num edges. R is the calling routine. procedure Check_Number_Of_Vertices (R : String; G : Directed_Graph; Exp_Num : Natural); -- Verify that graph G has exactly Exp_Num vertices. R is the calling -- routine. procedure Check_Outgoing_Edge_Iterator (R : String; G : Directed_Graph; V : Vertex_Id; Set : ES.Membership_Set); -- Verify that all outgoing edges of vertex V of graph G can be iterated -- and appear in set Set. R is the calling routine. procedure Check_Source_Vertex (R : String; G : Directed_Graph; E : Edge_Id; Exp_V : Vertex_Id); -- Vertify that the source vertex of edge E of grah G is Exp_V. R is the -- calling routine. procedure Check_Vertex_Iterator (R : String; G : Directed_Graph; Comp : Component_Id; Set : VS.Membership_Set); -- Verify that all vertices of component Comp of graph G can be iterated -- and appear in set Set. R is the calling routine. function Create_And_Populate return Directed_Graph; -- Create a brand new graph (see body for the shape of the graph) procedure Error (R : String; Msg : String); -- Output an error message with text Msg within the context of routine R procedure Test_Add_Edge; -- Verify the semantics of routine Add_Edge procedure Test_Add_Vertex; -- Verify the semantics of routine Add_Vertex procedure Test_All_Edge_Iterator; -- Verify the semantics of All_Edge_Iterator procedure Test_All_Vertex_Iterator; -- Verify the semantics of All_Vertex_Iterator procedure Test_Component; -- Verify the semantics of routine Component procedure Test_Component_Iterator; -- Verify the semantics of Component_Iterator procedure Test_Contains_Component; -- Verify the semantics of routine Contains_Component procedure Test_Contains_Edge; -- Verify the semantics of routine Contains_Edge procedure Test_Contains_Vertex; -- Verify the semantics of routine Contains_Vertex procedure Test_Delete_Edge; -- Verify the semantics of routine Delete_Edge procedure Test_Destination_Vertex; -- Verify the semantics of routine Destination_Vertex procedure Test_Find_Components; -- Verify the semantics of routine Find_Components procedure Test_Is_Empty; -- Verify the semantics of routine Is_Empty procedure Test_Number_Of_Components; -- Verify the semantics of routine Number_Of_Components procedure Test_Number_Of_Edges; -- Verify the semantics of routine Number_Of_Edges procedure Test_Number_Of_Vertices; -- Verify the semantics of routine Number_Of_Vertices procedure Test_Outgoing_Edge_Iterator; -- Verify the semantics of Outgoing_Edge_Iterator procedure Test_Present; -- Verify the semantics of routine Present procedure Test_Source_Vertex; -- Verify the semantics of routine Source_Vertex procedure Test_Vertex_Iterator; -- Verify the semantics of Vertex_Iterator; procedure Unexpected_Exception (R : String); -- Output an error message concerning an unexpected exception within -- routine R. -------------------------------- -- Check_Belongs_To_Component -- -------------------------------- procedure Check_Belongs_To_Component (R : String; G : Directed_Graph; V : Vertex_Id; Exp_Comp : Component_Id) is Act_Comp : constant Component_Id := Component (G, V); begin if Act_Comp /= Exp_Comp then Error (R, "inconsistent component for vertex " & V'Img); Error (R, " expected: " & Exp_Comp'Img); Error (R, " got : " & Act_Comp'Img); end if; end Check_Belongs_To_Component; ------------------------------------- -- Check_Belongs_To_Some_Component -- ------------------------------------- procedure Check_Belongs_To_Some_Component (R : String; G : Directed_Graph; V : Vertex_Id) is begin if not Present (Component (G, V)) then Error (R, "vertex " & V'Img & " does not belong to a component"); end if; end Check_Belongs_To_Some_Component; ------------------------------ -- Check_Destination_Vertex -- ------------------------------ procedure Check_Destination_Vertex (R : String; G : Directed_Graph; E : Edge_Id; Exp_V : Vertex_Id) is Act_V : constant Vertex_Id := Destination_Vertex (G, E); begin if Act_V /= Exp_V then Error (R, "inconsistent destination vertex for edge " & E'Img); Error (R, " expected: " & Exp_V'Img); Error (R, " got : " & Act_V'Img); end if; end Check_Destination_Vertex; ------------------------------- -- Check_Distinct_Components -- ------------------------------- procedure Check_Distinct_Components (R : String; Comp_1 : Component_Id; Comp_2 : Component_Id) is begin if Comp_1 = Comp_2 then Error (R, "components are not distinct"); end if; end Check_Distinct_Components; ------------------------- -- Check_Has_Component -- ------------------------- procedure Check_Has_Component (R : String; G : Directed_Graph; G_Name : String; Comp : Component_Id) is begin if not Contains_Component (G, Comp) then Error (R, "graph " & G_Name & " lacks component"); end if; end Check_Has_Component; -------------------- -- Check_Has_Edge -- -------------------- procedure Check_Has_Edge (R : String; G : Directed_Graph; E : Edge_Id) is begin if not Contains_Edge (G, E) then Error (R, "graph lacks edge " & E'Img); end if; end Check_Has_Edge; ---------------------- -- Check_Has_Vertex -- ---------------------- procedure Check_Has_Vertex (R : String; G : Directed_Graph; V : Vertex_Id) is begin if not Contains_Vertex (G, V) then Error (R, "graph lacks vertex " & V'Img); end if; end Check_Has_Vertex; ------------------------ -- Check_No_Component -- ------------------------ procedure Check_No_Component (R : String; G : Directed_Graph; V : Vertex_Id) is begin if Present (Component (G, V)) then Error (R, "vertex " & V'Img & " belongs to a component"); end if; end Check_No_Component; procedure Check_No_Component (R : String; G : Directed_Graph; G_Name : String; Comp : Component_Id) is begin if Contains_Component (G, Comp) then Error (R, "graph " & G_Name & " contains component"); end if; end Check_No_Component; ------------------- -- Check_No_Edge -- ------------------- procedure Check_No_Edge (R : String; G : Directed_Graph; E : Edge_Id) is begin if Contains_Edge (G, E) then Error (R, "graph contains edge " & E'Img); end if; end Check_No_Edge; --------------------- -- Check_No_Vertex -- --------------------- procedure Check_No_Vertex (R : String; G : Directed_Graph; V : Vertex_Id) is begin if Contains_Vertex (G, V) then Error (R, "graph contains vertex " & V'Img); end if; end Check_No_Vertex; -------------------------------- -- Check_Number_Of_Components -- -------------------------------- procedure Check_Number_Of_Components (R : String; G : Directed_Graph; Exp_Num : Natural) is Act_Num : constant Natural := Number_Of_Components (G); begin if Act_Num /= Exp_Num then Error (R, "inconsistent number of components"); Error (R, " expected: " & Exp_Num'Img); Error (R, " got : " & Act_Num'Img); end if; end Check_Number_Of_Components; --------------------------- -- Check_Number_Of_Edges -- --------------------------- procedure Check_Number_Of_Edges (R : String; G : Directed_Graph; Exp_Num : Natural) is Act_Num : constant Natural := Number_Of_Edges (G); begin if Act_Num /= Exp_Num then Error (R, "inconsistent number of edges"); Error (R, " expected: " & Exp_Num'Img); Error (R, " got : " & Act_Num'Img); end if; end Check_Number_Of_Edges; ------------------------------ -- Check_Number_Of_Vertices -- ------------------------------ procedure Check_Number_Of_Vertices (R : String; G : Directed_Graph; Exp_Num : Natural) is Act_Num : constant Natural := Number_Of_Vertices (G); begin if Act_Num /= Exp_Num then Error (R, "inconsistent number of vertices"); Error (R, " expected: " & Exp_Num'Img); Error (R, " got : " & Act_Num'Img); end if; end Check_Number_Of_Vertices; ---------------------------------- -- Check_Outgoing_Edge_Iterator -- ---------------------------------- procedure Check_Outgoing_Edge_Iterator (R : String; G : Directed_Graph; V : Vertex_Id; Set : ES.Membership_Set) is E : Edge_Id; Out_E_Iter : Outgoing_Edge_Iterator; begin -- Iterate over all outgoing edges of vertex V while removing edges seen -- from the set. Out_E_Iter := Iterate_Outgoing_Edges (G, V); while Has_Next (Out_E_Iter) loop Next (Out_E_Iter, E); if ES.Contains (Set, E) then ES.Delete (Set, E); else Error (R, "outgoing edge " & E'Img & " is not iterated"); end if; end loop; -- At this point the set of edges should be empty if not ES.Is_Empty (Set) then Error (R, "not all outgoing edges were iterated"); end if; end Check_Outgoing_Edge_Iterator; ------------------------- -- Check_Source_Vertex -- ------------------------- procedure Check_Source_Vertex (R : String; G : Directed_Graph; E : Edge_Id; Exp_V : Vertex_Id) is Act_V : constant Vertex_Id := Source_Vertex (G, E); begin if Act_V /= Exp_V then Error (R, "inconsistent source vertex"); Error (R, " expected: " & Exp_V'Img); Error (R, " got : " & Act_V'Img); end if; end Check_Source_Vertex; --------------------------- -- Check_Vertex_Iterator -- --------------------------- procedure Check_Vertex_Iterator (R : String; G : Directed_Graph; Comp : Component_Id; Set : VS.Membership_Set) is V : Vertex_Id; V_Iter : Vertex_Iterator; begin -- Iterate over all vertices of component Comp while removing vertices -- seen from the set. V_Iter := Iterate_Vertices (G, Comp); while Has_Next (V_Iter) loop Next (V_Iter, V); if VS.Contains (Set, V) then VS.Delete (Set, V); else Error (R, "vertex " & V'Img & " is not iterated"); end if; end loop; -- At this point the set of vertices should be empty if not VS.Is_Empty (Set) then Error (R, "not all vertices were iterated"); end if; end Check_Vertex_Iterator; ------------------------- -- Create_And_Populate -- ------------------------- function Create_And_Populate return Directed_Graph is G : constant Directed_Graph := Create (Initial_Vertices => Vertex_Id'Size, Initial_Edges => Edge_Id'Size); begin -- 9 8 1 2 -- G <------ F <------ A ------> B -------> C -- | ^ | | ^ ^ -- +------------------+ | +-------------------+ -- 10 | | 3 -- 4 | 5 | -- v | -- H D ---------+ -- | ^ -- | | -- 6 | | 7 -- | | -- v | -- E -- -- Components: -- -- [A, F, G] -- [B] -- [C] -- [D, E] -- [H] Add_Vertex (G, VA); Add_Vertex (G, VB); Add_Vertex (G, VC); Add_Vertex (G, VD); Add_Vertex (G, VE); Add_Vertex (G, VF); Add_Vertex (G, VG); Add_Vertex (G, VH); Add_Edge (G, E1, Source => VA, Destination => VB); Add_Edge (G, E2, Source => VB, Destination => VC); Add_Edge (G, E3, Source => VA, Destination => VC); Add_Edge (G, E4, Source => VA, Destination => VD); Add_Edge (G, E5, Source => VD, Destination => VB); Add_Edge (G, E6, Source => VD, Destination => VE); Add_Edge (G, E7, Source => VE, Destination => VD); Add_Edge (G, E8, Source => VA, Destination => VF); Add_Edge (G, E9, Source => VF, Destination => VG); Add_Edge (G, E10, Source => VG, Destination => VA); return G; end Create_And_Populate; ----------- -- Error -- ----------- procedure Error (R : String; Msg : String) is begin Put_Line ("ERROR: " & R & ": " & Msg); end Error; --------------- -- Hash_Edge -- --------------- function Hash_Edge (E : Edge_Id) return Bucket_Range_Type is begin return Bucket_Range_Type (Edge_Id'Pos (E)); end Hash_Edge; ----------------- -- Hash_Vertex -- ----------------- function Hash_Vertex (V : Vertex_Id) return Bucket_Range_Type is begin return Bucket_Range_Type (Vertex_Id'Pos (V)); end Hash_Vertex; ------------------- -- Test_Add_Edge -- ------------------- procedure Test_Add_Edge is R : constant String := "Test_Add_Edge"; E : Edge_Id; G : Directed_Graph := Create_And_Populate; All_E_Iter : All_Edge_Iterator; Out_E_Iter : Outgoing_Edge_Iterator; begin -- Try to add the same edge twice begin Add_Edge (G, E1, VB, VH); Error (R, "duplicate edge not detected"); exception when Duplicate_Edge => null; when others => Unexpected_Exception (R); end; -- Try to add an edge with a bogus source begin Add_Edge (G, E97, Source => VX, Destination => VC); Error (R, "missing vertex not detected"); exception when Missing_Vertex => null; when others => Unexpected_Exception (R); end; -- Try to add an edge with a bogus destination begin Add_Edge (G, E97, Source => VF, Destination => VY); Error (R, "missing vertex not detected"); exception when Missing_Vertex => null; when others => Unexpected_Exception (R); end; -- Delete edge E1 between vertices VA and VB begin Delete_Edge (G, E1); exception when others => Unexpected_Exception (R); end; -- Try to re-add edge E1 begin Add_Edge (G, E1, Source => VA, Destination => VB); exception when others => Unexpected_Exception (R); end; -- Lock all edges in the graph All_E_Iter := Iterate_All_Edges (G); -- Try to add an edge given that all edges are locked begin Add_Edge (G, E97, Source => VG, Destination => VH); Error (R, "all edges not locked"); exception when Iterated => null; when others => Unexpected_Exception (R); end; -- Unlock all edges by iterating over them while Has_Next (All_E_Iter) loop Next (All_E_Iter, E); end loop; -- Lock all outgoing edges of vertex VD Out_E_Iter := Iterate_Outgoing_Edges (G, VD); -- Try to add an edge with source VD given that all edges of VD are -- locked. begin Add_Edge (G, E97, Source => VD, Destination => VG); Error (R, "outgoing edges of VD not locked"); exception when Iterated => null; when others => Unexpected_Exception (R); end; -- Unlock the edges of vertex VD by iterating over them while Has_Next (Out_E_Iter) loop Next (Out_E_Iter, E); end loop; Destroy (G); end Test_Add_Edge; --------------------- -- Test_Add_Vertex -- --------------------- procedure Test_Add_Vertex is R : constant String := "Test_Add_Vertex"; G : Directed_Graph := Create_And_Populate; V : Vertex_Id; All_V_Iter : All_Vertex_Iterator; begin -- Try to add the same vertex twice begin Add_Vertex (G, VD); Error (R, "duplicate vertex not detected"); exception when Duplicate_Vertex => null; when others => Unexpected_Exception (R); end; -- Lock all vertices in the graph All_V_Iter := Iterate_All_Vertices (G); -- Try to add a vertex given that all vertices are locked begin Add_Vertex (G, VZ); Error (R, "all vertices not locked"); exception when Iterated => null; when others => Unexpected_Exception (R); end; -- Unlock all vertices by iterating over them while Has_Next (All_V_Iter) loop Next (All_V_Iter, V); end loop; Destroy (G); end Test_Add_Vertex; ---------------------------- -- Test_All_Edge_Iterator -- ---------------------------- procedure Test_All_Edge_Iterator is R : constant String := "Test_All_Edge_Iterator"; E : Edge_Id; G : Directed_Graph := Create_And_Populate; All_E_Iter : All_Edge_Iterator; All_Edges : ES.Membership_Set; begin -- Collect all expected edges in a set All_Edges := ES.Create (Number_Of_Edges (G)); for Curr_E in E1 .. E10 loop ES.Insert (All_Edges, Curr_E); end loop; -- Iterate over all edges while removing encountered edges from the set All_E_Iter := Iterate_All_Edges (G); while Has_Next (All_E_Iter) loop Next (All_E_Iter, E); if ES.Contains (All_Edges, E) then ES.Delete (All_Edges, E); else Error (R, "edge " & E'Img & " is not iterated"); end if; end loop; -- At this point the set of edges should be empty if not ES.Is_Empty (All_Edges) then Error (R, "not all edges were iterated"); end if; ES.Destroy (All_Edges); Destroy (G); end Test_All_Edge_Iterator; ------------------------------ -- Test_All_Vertex_Iterator -- ------------------------------ procedure Test_All_Vertex_Iterator is R : constant String := "Test_All_Vertex_Iterator"; G : Directed_Graph := Create_And_Populate; V : Vertex_Id; All_V_Iter : All_Vertex_Iterator; All_Vertices : VS.Membership_Set; begin -- Collect all expected vertices in a set All_Vertices := VS.Create (Number_Of_Vertices (G)); for Curr_V in VA .. VH loop VS.Insert (All_Vertices, Curr_V); end loop; -- Iterate over all vertices while removing encountered vertices from -- the set. All_V_Iter := Iterate_All_Vertices (G); while Has_Next (All_V_Iter) loop Next (All_V_Iter, V); if VS.Contains (All_Vertices, V) then VS.Delete (All_Vertices, V); else Error (R, "vertex " & V'Img & " is not iterated"); end if; end loop; -- At this point the set of vertices should be empty if not VS.Is_Empty (All_Vertices) then Error (R, "not all vertices were iterated"); end if; VS.Destroy (All_Vertices); Destroy (G); end Test_All_Vertex_Iterator; -------------------- -- Test_Component -- -------------------- procedure Test_Component is R : constant String := "Test_Component"; G : Directed_Graph := Create (Initial_Vertices => 3, Initial_Edges => 2); begin -- E1 -- -----> -- VA VB VC -- <----- -- E2 -- -- Components: -- -- [VA, VB] -- [VC] Add_Vertex (G, VA); Add_Vertex (G, VB); Add_Vertex (G, VC); Add_Edge (G, E1, Source => VA, Destination => VB); Add_Edge (G, E2, Source => VB, Destination => VA); -- None of the vertices should belong to a component Check_No_Component (R, G, VA); Check_No_Component (R, G, VB); Check_No_Component (R, G, VC); -- Find the strongly connected components in the graph Find_Components (G); -- Vertices should belong to a component Check_Belongs_To_Some_Component (R, G, VA); Check_Belongs_To_Some_Component (R, G, VB); Check_Belongs_To_Some_Component (R, G, VC); Destroy (G); end Test_Component; ----------------------------- -- Test_Component_Iterator -- ----------------------------- procedure Test_Component_Iterator is R : constant String := "Test_Component_Iterator"; G : Directed_Graph := Create_And_Populate; Comp : Component_Id; Comp_Count : Natural; Comp_Iter : Component_Iterator; begin Find_Components (G); Check_Number_Of_Components (R, G, 5); Comp_Count := Number_Of_Components (G); -- Iterate over all components while decrementing their number Comp_Iter := Iterate_Components (G); while Has_Next (Comp_Iter) loop Next (Comp_Iter, Comp); Comp_Count := Comp_Count - 1; end loop; -- At this point all components should have been accounted for if Comp_Count /= 0 then Error (R, "not all components were iterated"); end if; Destroy (G); end Test_Component_Iterator; ----------------------------- -- Test_Contains_Component -- ----------------------------- procedure Test_Contains_Component is R : constant String := "Test_Contains_Component"; G1 : Directed_Graph := Create (Initial_Vertices => 2, Initial_Edges => 2); G2 : Directed_Graph := Create (Initial_Vertices => 2, Initial_Edges => 2); begin -- E1 -- -----> -- VA VB -- <----- -- E2 -- -- Components: -- -- [VA, VB] Add_Vertex (G1, VA); Add_Vertex (G1, VB); Add_Edge (G1, E1, Source => VA, Destination => VB); Add_Edge (G1, E2, Source => VB, Destination => VA); -- E97 -- -----> -- VX VY -- <----- -- E98 -- -- Components: -- -- [VX, VY] Add_Vertex (G2, VX); Add_Vertex (G2, VY); Add_Edge (G2, E97, Source => VX, Destination => VY); Add_Edge (G2, E98, Source => VY, Destination => VX); -- Find the strongly connected components in both graphs Find_Components (G1); Find_Components (G2); -- Vertices should belong to a component Check_Belongs_To_Some_Component (R, G1, VA); Check_Belongs_To_Some_Component (R, G1, VB); Check_Belongs_To_Some_Component (R, G2, VX); Check_Belongs_To_Some_Component (R, G2, VY); -- Verify that each graph contains the correct component Check_Has_Component (R, G1, "G1", Component (G1, VA)); Check_Has_Component (R, G1, "G1", Component (G1, VB)); Check_Has_Component (R, G2, "G2", Component (G2, VX)); Check_Has_Component (R, G2, "G2", Component (G2, VY)); -- Verify that each graph does not contain components from the other -- graph. Check_No_Component (R, G1, "G1", Component (G2, VX)); Check_No_Component (R, G1, "G1", Component (G2, VY)); Check_No_Component (R, G2, "G2", Component (G1, VA)); Check_No_Component (R, G2, "G2", Component (G1, VB)); Destroy (G1); Destroy (G2); end Test_Contains_Component; ------------------------ -- Test_Contains_Edge -- ------------------------ procedure Test_Contains_Edge is R : constant String := "Test_Contains_Edge"; G : Directed_Graph := Create_And_Populate; begin -- Verify that all edges in the range E1 .. E10 exist for Curr_E in E1 .. E10 loop Check_Has_Edge (R, G, Curr_E); end loop; -- Verify that no extra edges are present for Curr_E in E97 .. E99 loop Check_No_Edge (R, G, Curr_E); end loop; -- Add new edges E97, E98, and E99 Add_Edge (G, E97, Source => VG, Destination => VF); Add_Edge (G, E98, Source => VH, Destination => VE); Add_Edge (G, E99, Source => VD, Destination => VC); -- Verify that all edges in the range E1 .. E99 exist for Curr_E in E1 .. E99 loop Check_Has_Edge (R, G, Curr_E); end loop; -- Delete each edge that corresponds to an even position in Edge_Id for Curr_E in E1 .. E99 loop if Edge_Id'Pos (Curr_E) mod 2 = 0 then Delete_Edge (G, Curr_E); end if; end loop; -- Verify that all "even" edges are missing, and all "odd" edges are -- present. for Curr_E in E1 .. E99 loop if Edge_Id'Pos (Curr_E) mod 2 = 0 then Check_No_Edge (R, G, Curr_E); else Check_Has_Edge (R, G, Curr_E); end if; end loop; Destroy (G); end Test_Contains_Edge; -------------------------- -- Test_Contains_Vertex -- -------------------------- procedure Test_Contains_Vertex is R : constant String := "Test_Contains_Vertex"; G : Directed_Graph := Create_And_Populate; begin -- Verify that all vertices in the range VA .. VH exist for Curr_V in VA .. VH loop Check_Has_Vertex (R, G, Curr_V); end loop; -- Verify that no extra vertices are present for Curr_V in VX .. VZ loop Check_No_Vertex (R, G, Curr_V); end loop; -- Add new vertices VX, VY, and VZ Add_Vertex (G, VX); Add_Vertex (G, VY); Add_Vertex (G, VZ); -- Verify that all vertices in the range VA .. VZ exist for Curr_V in VA .. VZ loop Check_Has_Vertex (R, G, Curr_V); end loop; Destroy (G); end Test_Contains_Vertex; ---------------------- -- Test_Delete_Edge -- ---------------------- procedure Test_Delete_Edge is R : constant String := "Test_Delete_Edge"; E : Edge_Id; G : Directed_Graph := Create_And_Populate; V : Vertex_Id; All_E_Iter : All_Edge_Iterator; All_V_Iter : All_Vertex_Iterator; Out_E_Iter : Outgoing_Edge_Iterator; begin -- Try to delete a bogus edge begin Delete_Edge (G, E97); Error (R, "missing vertex deleted"); exception when Missing_Edge => null; when others => Unexpected_Exception (R); end; -- Delete edge E1 between vertices VA and VB begin Delete_Edge (G, E1); exception when others => Unexpected_Exception (R); end; -- Verify that edge E1 is gone from all edges in the graph All_E_Iter := Iterate_All_Edges (G); while Has_Next (All_E_Iter) loop Next (All_E_Iter, E); if E = E1 then Error (R, "edge " & E'Img & " not removed from all edges"); end if; end loop; -- Verify that edge E1 is gone from the outgoing edges of vertex VA Out_E_Iter := Iterate_Outgoing_Edges (G, VA); while Has_Next (Out_E_Iter) loop Next (Out_E_Iter, E); if E = E1 then Error (R, "edge " & E'Img & "not removed from outgoing edges of VA"); end if; end loop; -- Delete all edges in the range E2 .. E10 for Curr_E in E2 .. E10 loop Delete_Edge (G, Curr_E); end loop; -- Verify that all edges are gone from the graph All_E_Iter := Iterate_All_Edges (G); while Has_Next (All_E_Iter) loop Next (All_E_Iter, E); Error (R, "edge " & E'Img & " not removed from all edges"); end loop; -- Verify that all edges are gone from the respective source vertices All_V_Iter := Iterate_All_Vertices (G); while Has_Next (All_V_Iter) loop Next (All_V_Iter, V); Out_E_Iter := Iterate_Outgoing_Edges (G, V); while Has_Next (Out_E_Iter) loop Next (Out_E_Iter, E); Error (R, "edge " & E'Img & " not removed from vertex " & V'Img); end loop; end loop; Destroy (G); end Test_Delete_Edge; ----------------------------- -- Test_Destination_Vertex -- ----------------------------- procedure Test_Destination_Vertex is R : constant String := "Test_Destination_Vertex"; G : Directed_Graph := Create_And_Populate; begin -- Verify the destination vertices of all edges in the graph Check_Destination_Vertex (R, G, E1, VB); Check_Destination_Vertex (R, G, E2, VC); Check_Destination_Vertex (R, G, E3, VC); Check_Destination_Vertex (R, G, E4, VD); Check_Destination_Vertex (R, G, E5, VB); Check_Destination_Vertex (R, G, E6, VE); Check_Destination_Vertex (R, G, E7, VD); Check_Destination_Vertex (R, G, E8, VF); Check_Destination_Vertex (R, G, E9, VG); Check_Destination_Vertex (R, G, E10, VA); Destroy (G); end Test_Destination_Vertex; -------------------------- -- Test_Find_Components -- -------------------------- procedure Test_Find_Components is R : constant String := "Test_Find_Components"; G : Directed_Graph := Create_And_Populate; Comp_1 : Component_Id; -- [A, F, G] Comp_2 : Component_Id; -- [B] Comp_3 : Component_Id; -- [C] Comp_4 : Component_Id; -- [D, E] Comp_5 : Component_Id; -- [H] begin Find_Components (G); -- Vertices should belong to a component Check_Belongs_To_Some_Component (R, G, VA); Check_Belongs_To_Some_Component (R, G, VB); Check_Belongs_To_Some_Component (R, G, VC); Check_Belongs_To_Some_Component (R, G, VD); Check_Belongs_To_Some_Component (R, G, VH); -- Extract the ids of the components from the first vertices in each -- component. Comp_1 := Component (G, VA); Comp_2 := Component (G, VB); Comp_3 := Component (G, VC); Comp_4 := Component (G, VD); Comp_5 := Component (G, VH); -- Verify that the components are distinct Check_Distinct_Components (R, Comp_1, Comp_2); Check_Distinct_Components (R, Comp_1, Comp_3); Check_Distinct_Components (R, Comp_1, Comp_4); Check_Distinct_Components (R, Comp_1, Comp_5); Check_Distinct_Components (R, Comp_2, Comp_3); Check_Distinct_Components (R, Comp_2, Comp_4); Check_Distinct_Components (R, Comp_2, Comp_5); Check_Distinct_Components (R, Comp_3, Comp_4); Check_Distinct_Components (R, Comp_3, Comp_5); Check_Distinct_Components (R, Comp_4, Comp_5); -- Verify that the remaining nodes belong to the proper component Check_Belongs_To_Component (R, G, VF, Comp_1); Check_Belongs_To_Component (R, G, VG, Comp_1); Check_Belongs_To_Component (R, G, VE, Comp_4); Destroy (G); end Test_Find_Components; ------------------- -- Test_Is_Empty -- ------------------- procedure Test_Is_Empty is R : constant String := "Test_Is_Empty"; G : Directed_Graph := Create (Initial_Vertices => 3, Initial_Edges => 2); begin -- Verify that a graph without vertices and edges is empty if not Is_Empty (G) then Error (R, "graph is empty"); end if; -- Add vertices Add_Vertex (G, VA); Add_Vertex (G, VB); -- Verify that a graph with vertices and no edges is not empty if Is_Empty (G) then Error (R, "graph is not empty"); end if; -- Add edges Add_Edge (G, E1, Source => VA, Destination => VB); -- Verify that a graph with vertices and edges is not empty if Is_Empty (G) then Error (R, "graph is not empty"); end if; Destroy (G); end Test_Is_Empty; ------------------------------- -- Test_Number_Of_Components -- ------------------------------- procedure Test_Number_Of_Components is R : constant String := "Test_Number_Of_Components"; G : Directed_Graph := Create (Initial_Vertices => 3, Initial_Edges => 2); begin -- Verify that an empty graph has exactly 0 components Check_Number_Of_Components (R, G, 0); -- E1 -- -----> -- VA VB VC -- <----- -- E2 -- -- Components: -- -- [VA, VB] -- [VC] Add_Vertex (G, VA); Add_Vertex (G, VB); Add_Vertex (G, VC); Add_Edge (G, E1, Source => VA, Destination => VB); Add_Edge (G, E2, Source => VB, Destination => VA); -- Verify that the graph has exact 0 components even though it contains -- vertices and edges. Check_Number_Of_Components (R, G, 0); Find_Components (G); -- Verify that the graph has exactly 2 components Check_Number_Of_Components (R, G, 2); Destroy (G); end Test_Number_Of_Components; -------------------------- -- Test_Number_Of_Edges -- -------------------------- procedure Test_Number_Of_Edges is R : constant String := "Test_Number_Of_Edges"; G : Directed_Graph := Create_And_Populate; begin -- Verify that the graph has exactly 10 edges Check_Number_Of_Edges (R, G, 10); -- Delete two edges Delete_Edge (G, E1); Delete_Edge (G, E2); -- Verify that the graph has exactly 8 edges Check_Number_Of_Edges (R, G, 8); -- Delete the remaining edge for Curr_E in E3 .. E10 loop Delete_Edge (G, Curr_E); end loop; -- Verify that the graph has exactly 0 edges Check_Number_Of_Edges (R, G, 0); -- Add two edges Add_Edge (G, E1, Source => VF, Destination => VA); Add_Edge (G, E2, Source => VC, Destination => VH); -- Verify that the graph has exactly 2 edges Check_Number_Of_Edges (R, G, 2); Destroy (G); end Test_Number_Of_Edges; ----------------------------- -- Test_Number_Of_Vertices -- ----------------------------- procedure Test_Number_Of_Vertices is R : constant String := "Test_Number_Of_Vertices"; G : Directed_Graph := Create (Initial_Vertices => 4, Initial_Edges => 12); begin -- Verify that an empty graph has exactly 0 vertices Check_Number_Of_Vertices (R, G, 0); -- Add three vertices Add_Vertex (G, VC); Add_Vertex (G, VG); Add_Vertex (G, VX); -- Verify that the graph has exactly 3 vertices Check_Number_Of_Vertices (R, G, 3); -- Add one edge Add_Edge (G, E8, Source => VX, Destination => VG); -- Verify that the graph has exactly 3 vertices Check_Number_Of_Vertices (R, G, 3); Destroy (G); end Test_Number_Of_Vertices; --------------------------------- -- Test_Outgoing_Edge_Iterator -- --------------------------------- procedure Test_Outgoing_Edge_Iterator is R : constant String := "Test_Outgoing_Edge_Iterator"; G : Directed_Graph := Create_And_Populate; Set : ES.Membership_Set; begin Set := ES.Create (4); ES.Insert (Set, E1); ES.Insert (Set, E3); ES.Insert (Set, E4); ES.Insert (Set, E8); Check_Outgoing_Edge_Iterator (R, G, VA, Set); ES.Insert (Set, E2); Check_Outgoing_Edge_Iterator (R, G, VB, Set); Check_Outgoing_Edge_Iterator (R, G, VC, Set); ES.Insert (Set, E5); ES.Insert (Set, E6); Check_Outgoing_Edge_Iterator (R, G, VD, Set); ES.Insert (Set, E7); Check_Outgoing_Edge_Iterator (R, G, VE, Set); ES.Insert (Set, E9); Check_Outgoing_Edge_Iterator (R, G, VF, Set); ES.Insert (Set, E10); Check_Outgoing_Edge_Iterator (R, G, VG, Set); Check_Outgoing_Edge_Iterator (R, G, VH, Set); ES.Destroy (Set); Destroy (G); end Test_Outgoing_Edge_Iterator; ------------------ -- Test_Present -- ------------------ procedure Test_Present is R : constant String := "Test_Present"; G : Directed_Graph := Nil; begin -- Verify that a non-existent graph is not present if Present (G) then Error (R, "graph is not present"); end if; G := Create_And_Populate; -- Verify that an existing graph is present if not Present (G) then Error (R, "graph is present"); end if; Destroy (G); -- Verify that a destroyed graph is not present if Present (G) then Error (R, "graph is not present"); end if; end Test_Present; ------------------------ -- Test_Source_Vertex -- ------------------------ procedure Test_Source_Vertex is R : constant String := "Test_Source_Vertex"; G : Directed_Graph := Create_And_Populate; begin -- Verify the source vertices of all edges in the graph Check_Source_Vertex (R, G, E1, VA); Check_Source_Vertex (R, G, E2, VB); Check_Source_Vertex (R, G, E3, VA); Check_Source_Vertex (R, G, E4, VA); Check_Source_Vertex (R, G, E5, VD); Check_Source_Vertex (R, G, E6, VD); Check_Source_Vertex (R, G, E7, VE); Check_Source_Vertex (R, G, E8, VA); Check_Source_Vertex (R, G, E9, VF); Check_Source_Vertex (R, G, E10, VG); Destroy (G); end Test_Source_Vertex; -------------------------- -- Test_Vertex_Iterator -- -------------------------- procedure Test_Vertex_Iterator is R : constant String := "Test_Vertex_Iterator"; G : Directed_Graph := Create_And_Populate; Set : VS.Membership_Set; begin Find_Components (G); Set := VS.Create (3); VS.Insert (Set, VA); VS.Insert (Set, VF); VS.Insert (Set, VG); Check_Vertex_Iterator (R, G, Component (G, VA), Set); VS.Insert (Set, VB); Check_Vertex_Iterator (R, G, Component (G, VB), Set); VS.Insert (Set, VC); Check_Vertex_Iterator (R, G, Component (G, VC), Set); VS.Insert (Set, VD); VS.Insert (Set, VE); Check_Vertex_Iterator (R, G, Component (G, VD), Set); VS.Insert (Set, VH); Check_Vertex_Iterator (R, G, Component (G, VH), Set); VS.Destroy (Set); Destroy (G); end Test_Vertex_Iterator; -------------------------- -- Unexpected_Exception -- -------------------------- procedure Unexpected_Exception (R : String) is begin Error (R, "unexpected exception"); end Unexpected_Exception; -- Start of processing for Operations begin Test_Add_Edge; Test_Add_Vertex; Test_All_Edge_Iterator; Test_All_Vertex_Iterator; Test_Component; Test_Component_Iterator; Test_Contains_Component; Test_Contains_Edge; Test_Contains_Vertex; Test_Delete_Edge; Test_Destination_Vertex; Test_Find_Components; Test_Is_Empty; Test_Number_Of_Components; Test_Number_Of_Edges; Test_Number_Of_Vertices; Test_Outgoing_Edge_Iterator; Test_Present; Test_Source_Vertex; Test_Vertex_Iterator; end Operations; ---------------------------- -- Compilation and output -- ---------------------------- $ gnatmake -q operations.adb -largs -lgmem $ ./operations $ gnatmem operations > leaks.txt $ grep -c "non freed allocations" leaks.txt 0 2019-07-01 Hristian Kirtchev gcc/ada/ * libgnat/g-graphs.adb: Use type Directed_Graph rather than Instance in various routines. * libgnat/g-graphs.ads: Change type Instance to Directed_Graph. Update various routines that mention the type. From-SVN: r272863 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 05aaf2315b6..f11697b2822 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,10 @@ +2019-07-01 Hristian Kirtchev + + * libgnat/g-graphs.adb: Use type Directed_Graph rather than + Instance in various routines. + * libgnat/g-graphs.ads: Change type Instance to Directed_Graph. + Update various routines that mention the type. + 2019-07-01 Hristian Kirtchev * libgnat/g-sets.adb: Use type Membership_Set rathern than diff --git a/gcc/ada/libgnat/g-graphs.adb b/gcc/ada/libgnat/g-graphs.adb index a763efb2a81..210e08363cb 100644 --- a/gcc/ada/libgnat/g-graphs.adb +++ b/gcc/ada/libgnat/g-graphs.adb @@ -45,107 +45,109 @@ package body GNAT.Graphs is -- Directed_Graph -- -------------------- - package body Directed_Graph is + package body Directed_Graphs is ----------------------- -- Local subprograms -- ----------------------- procedure Add_Component - (G : Instance; + (G : Directed_Graph; Comp : Component_Id; - Vertices : Vertex_List.Instance); + Vertices : Vertex_List.Doubly_Linked_List); pragma Inline (Add_Component); -- Add component Comp which houses vertices Vertices to graph G - procedure Ensure_Created (G : Instance); + procedure Ensure_Created (G : Directed_Graph); pragma Inline (Ensure_Created); -- Verify that graph G is created. Raise Not_Created if this is not the -- case. procedure Ensure_Not_Present - (G : Instance; + (G : Directed_Graph; E : Edge_Id); pragma Inline (Ensure_Not_Present); -- Verify that graph G lacks edge E. Raise Duplicate_Edge if this is not -- the case. procedure Ensure_Not_Present - (G : Instance; + (G : Directed_Graph; V : Vertex_Id); pragma Inline (Ensure_Not_Present); -- Verify that graph G lacks vertex V. Raise Duplicate_Vertex if this is -- not the case. procedure Ensure_Present - (G : Instance; + (G : Directed_Graph; Comp : Component_Id); pragma Inline (Ensure_Present); -- Verify that component Comp exists in graph G. Raise Missing_Component -- if this is not the case. procedure Ensure_Present - (G : Instance; + (G : Directed_Graph; E : Edge_Id); pragma Inline (Ensure_Present); -- Verify that edge E is present in graph G. Raise Missing_Edge if this -- is not the case. procedure Ensure_Present - (G : Instance; + (G : Directed_Graph; V : Vertex_Id); pragma Inline (Ensure_Present); -- Verify that vertex V is present in graph G. Raise Missing_Vertex if -- this is not the case. - procedure Free is new Ada.Unchecked_Deallocation (Graph, Instance); + procedure Free is + new Ada.Unchecked_Deallocation + (Directed_Graph_Attributes, Directed_Graph); function Get_Component_Attributes - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) return Component_Attributes; pragma Inline (Get_Component_Attributes); -- Obtain the attributes of component Comp of graph G function Get_Edge_Attributes - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Edge_Attributes; pragma Inline (Get_Edge_Attributes); -- Obtain the attributes of edge E of graph G function Get_Vertex_Attributes - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Vertex_Attributes; pragma Inline (Get_Vertex_Attributes); -- Obtain the attributes of vertex V of graph G function Get_Outgoing_Edges - (G : Instance; - V : Vertex_Id) return Edge_Set.Instance; + (G : Directed_Graph; + V : Vertex_Id) return Edge_Set.Membership_Set; pragma Inline (Get_Outgoing_Edges); -- Obtain the Outgoing_Edges attribute of vertex V of graph G function Get_Vertices - (G : Instance; - Comp : Component_Id) return Vertex_List.Instance; + (G : Directed_Graph; + Comp : Component_Id) return Vertex_List.Doubly_Linked_List; pragma Inline (Get_Vertices); -- Obtain the Vertices attribute of component Comp of graph G procedure Set_Component - (G : Instance; + (G : Directed_Graph; V : Vertex_Id; Val : Component_Id); pragma Inline (Set_Component); -- Set attribute Component of vertex V of graph G to value Val procedure Set_Outgoing_Edges - (G : Instance; + (G : Directed_Graph; V : Vertex_Id; - Val : Edge_Set.Instance); + Val : Edge_Set.Membership_Set); pragma Inline (Set_Outgoing_Edges); -- Set attribute Outgoing_Edges of vertex V of graph G to value Val procedure Set_Vertex_Attributes - (G : Instance; + (G : Directed_Graph; V : Vertex_Id; Val : Vertex_Attributes); pragma Inline (Set_Vertex_Attributes); @@ -156,9 +158,9 @@ package body GNAT.Graphs is ------------------- procedure Add_Component - (G : Instance; + (G : Directed_Graph; Comp : Component_Id; - Vertices : Vertex_List.Instance) + Vertices : Vertex_List.Doubly_Linked_List) is begin pragma Assert (Present (G)); @@ -176,7 +178,7 @@ package body GNAT.Graphs is -------------- procedure Add_Edge - (G : Instance; + (G : Directed_Graph; E : Edge_Id; Source : Vertex_Id; Destination : Vertex_Id) @@ -209,7 +211,7 @@ package body GNAT.Graphs is ---------------- procedure Add_Vertex - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) is begin @@ -239,7 +241,7 @@ package body GNAT.Graphs is --------------- function Component - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Component_Id is begin @@ -254,7 +256,7 @@ package body GNAT.Graphs is ------------------------ function Contains_Component - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) return Boolean is begin @@ -268,7 +270,7 @@ package body GNAT.Graphs is ------------------- function Contains_Edge - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Boolean is begin @@ -282,7 +284,7 @@ package body GNAT.Graphs is --------------------- function Contains_Vertex - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Boolean is begin @@ -297,9 +299,9 @@ package body GNAT.Graphs is function Create (Initial_Vertices : Positive; - Initial_Edges : Positive) return Instance + Initial_Edges : Positive) return Directed_Graph is - G : constant Instance := new Graph; + G : constant Directed_Graph := new Directed_Graph_Attributes; begin G.All_Edges := Edge_Map.Create (Initial_Edges); @@ -314,7 +316,7 @@ package body GNAT.Graphs is ----------------- procedure Delete_Edge - (G : Instance; + (G : Directed_Graph; E : Edge_Id) is Source : Vertex_Id; @@ -341,7 +343,7 @@ package body GNAT.Graphs is ------------------------ function Destination_Vertex - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Vertex_Id is begin @@ -355,7 +357,7 @@ package body GNAT.Graphs is -- Destroy -- ------------- - procedure Destroy (G : in out Instance) is + procedure Destroy (G : in out Directed_Graph) is begin Ensure_Created (G); @@ -410,7 +412,7 @@ package body GNAT.Graphs is -- Ensure_Created -- -------------------- - procedure Ensure_Created (G : Instance) is + procedure Ensure_Created (G : Directed_Graph) is begin if not Present (G) then raise Not_Created; @@ -422,7 +424,7 @@ package body GNAT.Graphs is ------------------------ procedure Ensure_Not_Present - (G : Instance; + (G : Directed_Graph; E : Edge_Id) is begin @@ -436,7 +438,7 @@ package body GNAT.Graphs is ------------------------ procedure Ensure_Not_Present - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) is begin @@ -450,7 +452,7 @@ package body GNAT.Graphs is -------------------- procedure Ensure_Present - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) is begin @@ -464,7 +466,7 @@ package body GNAT.Graphs is -------------------- procedure Ensure_Present - (G : Instance; + (G : Directed_Graph; E : Edge_Id) is begin @@ -478,7 +480,7 @@ package body GNAT.Graphs is -------------------- procedure Ensure_Present - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) is begin @@ -491,7 +493,7 @@ package body GNAT.Graphs is -- Find_Components -- --------------------- - procedure Find_Components (G : Instance) is + procedure Find_Components (G : Directed_Graph) is -- The components of graph G are discovered using Tarjan's strongly -- connected component algorithm. Do not modify this code unless you @@ -527,7 +529,7 @@ package body GNAT.Graphs is (Attrs : in out Tarjan_Attributes); -- Destroy the contents of attributes Attrs - package Tarjan_Map is new Dynamic_HTable + package Tarjan_Map is new Dynamic_Hash_Tables (Key_Type => Vertex_Id, Value_Type => Tarjan_Attributes, No_Value => No_Tarjan_Attributes, @@ -543,7 +545,7 @@ package body GNAT.Graphs is -- Tarjan_Stack -- ------------------ - package Tarjan_Stack is new Doubly_Linked_List + package Tarjan_Stack is new Doubly_Linked_Lists (Element_Type => Vertex_Id, "=" => Same_Vertex, Destroy_Element => Destroy_Vertex); @@ -552,8 +554,8 @@ package body GNAT.Graphs is -- Global data -- ----------------- - Attrs : Tarjan_Map.Instance := Tarjan_Map.Nil; - Stack : Tarjan_Stack.Instance := Tarjan_Stack.Nil; + Attrs : Tarjan_Map.Dynamic_Hash_Table := Tarjan_Map.Nil; + Stack : Tarjan_Stack.Doubly_Linked_List := Tarjan_Stack.Nil; ----------------------- -- Local subprograms -- @@ -689,7 +691,7 @@ package body GNAT.Graphs is procedure Create_Component (V : Vertex_Id) is Curr_V : Vertex_Id; - Vertices : Vertex_List.Instance; + Vertices : Vertex_List.Doubly_Linked_List; begin Vertices := Vertex_List.Create; @@ -1047,7 +1049,7 @@ package body GNAT.Graphs is ------------------------------ function Get_Component_Attributes - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) return Component_Attributes is begin @@ -1062,7 +1064,7 @@ package body GNAT.Graphs is ------------------------- function Get_Edge_Attributes - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Edge_Attributes is begin @@ -1077,7 +1079,7 @@ package body GNAT.Graphs is --------------------------- function Get_Vertex_Attributes - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Vertex_Attributes is begin @@ -1092,8 +1094,8 @@ package body GNAT.Graphs is ------------------------ function Get_Outgoing_Edges - (G : Instance; - V : Vertex_Id) return Edge_Set.Instance + (G : Directed_Graph; + V : Vertex_Id) return Edge_Set.Membership_Set is begin pragma Assert (Present (G)); @@ -1107,8 +1109,8 @@ package body GNAT.Graphs is ------------------ function Get_Vertices - (G : Instance; - Comp : Component_Id) return Vertex_List.Instance + (G : Directed_Graph; + Comp : Component_Id) return Vertex_List.Doubly_Linked_List is begin pragma Assert (Present (G)); @@ -1166,7 +1168,7 @@ package body GNAT.Graphs is -- Is_Empty -- -------------- - function Is_Empty (G : Instance) return Boolean is + function Is_Empty (G : Directed_Graph) return Boolean is begin Ensure_Created (G); @@ -1179,7 +1181,9 @@ package body GNAT.Graphs is -- Iterate_All_Edges -- ----------------------- - function Iterate_All_Edges (G : Instance) return All_Edge_Iterator is + function Iterate_All_Edges + (G : Directed_Graph) return All_Edge_Iterator + is begin Ensure_Created (G); @@ -1191,7 +1195,7 @@ package body GNAT.Graphs is -------------------------- function Iterate_All_Vertices - (G : Instance) return All_Vertex_Iterator + (G : Directed_Graph) return All_Vertex_Iterator is begin Ensure_Created (G); @@ -1203,7 +1207,9 @@ package body GNAT.Graphs is -- Iterate_Components -- ------------------------ - function Iterate_Components (G : Instance) return Component_Iterator is + function Iterate_Components + (G : Directed_Graph) return Component_Iterator + is begin Ensure_Created (G); @@ -1215,7 +1221,7 @@ package body GNAT.Graphs is ---------------------------- function Iterate_Outgoing_Edges - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Outgoing_Edge_Iterator is begin @@ -1232,7 +1238,7 @@ package body GNAT.Graphs is ---------------------- function Iterate_Vertices - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) return Vertex_Iterator is begin @@ -1306,7 +1312,7 @@ package body GNAT.Graphs is -- Number_Of_Components -- -------------------------- - function Number_Of_Components (G : Instance) return Natural is + function Number_Of_Components (G : Directed_Graph) return Natural is begin Ensure_Created (G); @@ -1317,7 +1323,7 @@ package body GNAT.Graphs is -- Number_Of_Edges -- --------------------- - function Number_Of_Edges (G : Instance) return Natural is + function Number_Of_Edges (G : Directed_Graph) return Natural is begin Ensure_Created (G); @@ -1328,7 +1334,7 @@ package body GNAT.Graphs is -- Number_Of_Vertices -- ------------------------ - function Number_Of_Vertices (G : Instance) return Natural is + function Number_Of_Vertices (G : Directed_Graph) return Natural is begin Ensure_Created (G); @@ -1339,7 +1345,7 @@ package body GNAT.Graphs is -- Present -- ------------- - function Present (G : Instance) return Boolean is + function Present (G : Directed_Graph) return Boolean is begin return G /= Nil; end Present; @@ -1349,7 +1355,7 @@ package body GNAT.Graphs is ------------------- procedure Set_Component - (G : Instance; + (G : Directed_Graph; V : Vertex_Id; Val : Component_Id) is @@ -1369,9 +1375,9 @@ package body GNAT.Graphs is ------------------------ procedure Set_Outgoing_Edges - (G : Instance; + (G : Directed_Graph; V : Vertex_Id; - Val : Edge_Set.Instance) + Val : Edge_Set.Membership_Set) is VA : Vertex_Attributes; @@ -1389,7 +1395,7 @@ package body GNAT.Graphs is --------------------------- procedure Set_Vertex_Attributes - (G : Instance; + (G : Directed_Graph; V : Vertex_Id; Val : Vertex_Attributes) is @@ -1405,7 +1411,7 @@ package body GNAT.Graphs is ------------------- function Source_Vertex - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Vertex_Id is begin @@ -1414,7 +1420,7 @@ package body GNAT.Graphs is return Get_Edge_Attributes (G, E).Source; end Source_Vertex; - end Directed_Graph; + end Directed_Graphs; -------------------- -- Hash_Component -- diff --git a/gcc/ada/libgnat/g-graphs.ads b/gcc/ada/libgnat/g-graphs.ads index 7926a1b8f35..c4bf17dffce 100644 --- a/gcc/ada/libgnat/g-graphs.ads +++ b/gcc/ada/libgnat/g-graphs.ads @@ -53,9 +53,9 @@ package GNAT.Graphs is function Present (Comp : Component_Id) return Boolean; -- Determine whether component Comp exists - -------------------- - -- Directed_Graph -- - -------------------- + --------------------- + -- Directed_Graphs -- + --------------------- -- The following package offers a directed graph abstraction with the -- following characteristics: @@ -67,7 +67,7 @@ package GNAT.Graphs is -- -- The following use pattern must be employed when operating this graph: -- - -- Graph : Instance := Create (, ); + -- Graph : Directed_Graph := Create (, ); -- -- -- @@ -113,7 +113,7 @@ package GNAT.Graphs is Right : Edge_Id) return Boolean; -- Compare edge Left to edge Right for identity - package Directed_Graph is + package Directed_Graphs is -- The following exceptions are raised when an attempt is made to add -- the same edge or vertex in a graph. @@ -135,11 +135,11 @@ package GNAT.Graphs is -- The following type denotes a graph handle. Each instance must be -- created using routine Create. - type Instance is private; - Nil : constant Instance; + type Directed_Graph is private; + Nil : constant Directed_Graph; procedure Add_Edge - (G : Instance; + (G : Directed_Graph; E : Edge_Id; Source : Vertex_Id; Destination : Vertex_Id); @@ -155,7 +155,7 @@ package GNAT.Graphs is -- present in the graph. procedure Add_Vertex - (G : Instance; + (G : Directed_Graph; V : Vertex_Id); -- Add vertex V to graph G. This action raises the following exceptions: -- @@ -164,7 +164,7 @@ package GNAT.Graphs is -- * Iterated, when the graph has an outstanding vertex iterator function Component - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Component_Id; -- Obtain the component where vertex V of graph G resides. This action -- raises the following exceptions: @@ -172,29 +172,29 @@ package GNAT.Graphs is -- * Missing_Vertex, when the vertex is not present in the graph function Contains_Component - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) return Boolean; -- Determine whether graph G contains component Comp function Contains_Edge - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Boolean; -- Determine whether graph G contains edge E function Contains_Vertex - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Boolean; -- Determine whether graph G contains vertex V function Create (Initial_Vertices : Positive; - Initial_Edges : Positive) return Instance; + Initial_Edges : Positive) return Directed_Graph; -- Create a new graph with vertex capacity Initial_Vertices and edge -- capacity Initial_Edges. This routine must be called at the start of -- a graph's lifetime. procedure Delete_Edge - (G : Instance; + (G : Directed_Graph; E : Edge_Id); -- Delete edge E from graph G. This action raises these exceptions: -- @@ -206,44 +206,44 @@ package GNAT.Graphs is -- not present in the graph. function Destination_Vertex - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Vertex_Id; -- Obtain the destination vertex of edge E of graph G. This action -- raises the following exceptions: -- -- * Missing_Edge, when the edge is not present in the graph - procedure Destroy (G : in out Instance); + procedure Destroy (G : in out Directed_Graph); -- Destroy the contents of graph G, rendering it unusable. This routine -- must be called at the end of a graph's lifetime. This action raises -- the following exceptions: -- -- * Iterated, if the graph has any outstanding iterator - procedure Find_Components (G : Instance); + procedure Find_Components (G : Directed_Graph); -- Find all components of graph G. This action raises the following -- exceptions: -- -- * Iterated, when the components or vertices of the graph have an -- outstanding iterator. - function Is_Empty (G : Instance) return Boolean; + function Is_Empty (G : Directed_Graph) return Boolean; -- Determine whether graph G is empty - function Number_Of_Components (G : Instance) return Natural; + function Number_Of_Components (G : Directed_Graph) return Natural; -- Obtain the total number of components of graph G - function Number_Of_Edges (G : Instance) return Natural; + function Number_Of_Edges (G : Directed_Graph) return Natural; -- Obtain the total number of edges of graph G - function Number_Of_Vertices (G : Instance) return Natural; + function Number_Of_Vertices (G : Directed_Graph) return Natural; -- Obtain the total number of vertices of graph G - function Present (G : Instance) return Boolean; + function Present (G : Directed_Graph) return Boolean; -- Determine whether graph G exists function Source_Vertex - (G : Instance; + (G : Directed_Graph; E : Edge_Id) return Vertex_Id; -- Obtain the source vertex that "owns" edge E of graph G. This action -- raises the following exceptions: @@ -274,7 +274,7 @@ package GNAT.Graphs is function Has_Next (Iter : All_Edge_Iterator) return Boolean; -- Determine whether iterator Iter has more edges to examine - function Iterate_All_Edges (G : Instance) return All_Edge_Iterator; + function Iterate_All_Edges (G : Directed_Graph) return All_Edge_Iterator; -- Obtain an iterator over all edges of graph G procedure Next @@ -294,7 +294,8 @@ package GNAT.Graphs is function Has_Next (Iter : All_Vertex_Iterator) return Boolean; -- Determine whether iterator Iter has more vertices to examine - function Iterate_All_Vertices (G : Instance) return All_Vertex_Iterator; + function Iterate_All_Vertices + (G : Directed_Graph) return All_Vertex_Iterator; -- Obtain an iterator over all vertices of graph G procedure Next @@ -315,7 +316,8 @@ package GNAT.Graphs is function Has_Next (Iter : Component_Iterator) return Boolean; -- Determine whether iterator Iter has more components to examine - function Iterate_Components (G : Instance) return Component_Iterator; + function Iterate_Components + (G : Directed_Graph) return Component_Iterator; -- Obtain an iterator over all components of graph G procedure Next @@ -336,7 +338,7 @@ package GNAT.Graphs is -- Determine whether iterator Iter has more outgoing edges to examine function Iterate_Outgoing_Edges - (G : Instance; + (G : Directed_Graph; V : Vertex_Id) return Outgoing_Edge_Iterator; -- Obtain an iterator over all the outgoing edges "owned" by vertex V of -- graph G. @@ -360,7 +362,7 @@ package GNAT.Graphs is -- Determine whether iterator Iter has more vertices to examine function Iterate_Vertices - (G : Instance; + (G : Directed_Graph; Comp : Component_Id) return Vertex_Iterator; -- Obtain an iterator over all vertices that comprise component Comp of -- graph G. @@ -396,7 +398,7 @@ package GNAT.Graphs is procedure Destroy_Edge_Attributes (Attrs : in out Edge_Attributes); -- Destroy the contents of attributes Attrs - package Edge_Map is new Dynamic_HTable + package Edge_Map is new Dynamic_Hash_Tables (Key_Type => Edge_Id, Value_Type => Edge_Attributes, No_Value => No_Edge_Attributes, @@ -412,7 +414,7 @@ package GNAT.Graphs is -- Edge_Set -- -------------- - package Edge_Set is new Membership_Set + package Edge_Set is new Membership_Sets (Element_Type => Edge_Id, "=" => "=", Hash => Hash_Edge); @@ -424,7 +426,7 @@ package GNAT.Graphs is procedure Destroy_Vertex (V : in out Vertex_Id); -- Destroy the contents of a vertex - package Vertex_List is new Doubly_Linked_List + package Vertex_List is new Doubly_Linked_Lists (Element_Type => Vertex_Id, "=" => Same_Vertex, Destroy_Element => Destroy_Vertex); @@ -437,7 +439,7 @@ package GNAT.Graphs is Component : Component_Id := No_Component; -- The component where a vertex lives - Outgoing_Edges : Edge_Set.Instance := Edge_Set.Nil; + Outgoing_Edges : Edge_Set.Membership_Set := Edge_Set.Nil; -- The set of edges that extend out from a vertex end record; @@ -448,7 +450,7 @@ package GNAT.Graphs is procedure Destroy_Vertex_Attributes (Attrs : in out Vertex_Attributes); -- Destroy the contents of attributes Attrs - package Vertex_Map is new Dynamic_HTable + package Vertex_Map is new Dynamic_Hash_Tables (Key_Type => Vertex_Id, Value_Type => Vertex_Attributes, No_Value => No_Vertex_Attributes, @@ -465,7 +467,7 @@ package GNAT.Graphs is ------------------- type Component_Attributes is record - Vertices : Vertex_List.Instance := Vertex_List.Nil; + Vertices : Vertex_List.Doubly_Linked_List := Vertex_List.Nil; end record; No_Component_Attributes : constant Component_Attributes := @@ -475,7 +477,7 @@ package GNAT.Graphs is (Attrs : in out Component_Attributes); -- Destroy the contents of attributes Attrs - package Component_Map is new Dynamic_HTable + package Component_Map is new Dynamic_Hash_Tables (Key_Type => Component_Id, Value_Type => Component_Attributes, No_Value => No_Component_Attributes, @@ -491,25 +493,21 @@ package GNAT.Graphs is -- Graph -- ----------- - type Graph is record - All_Edges : Edge_Map.Instance := Edge_Map.Nil; + type Directed_Graph_Attributes is record + All_Edges : Edge_Map.Dynamic_Hash_Table := Edge_Map.Nil; -- The map of edge -> edge attributes for all edges in the graph - All_Vertices : Vertex_Map.Instance := Vertex_Map.Nil; + All_Vertices : Vertex_Map.Dynamic_Hash_Table := Vertex_Map.Nil; -- The map of vertex -> vertex attributes for all vertices in the -- graph. - Components : Component_Map.Instance := Component_Map.Nil; + Components : Component_Map.Dynamic_Hash_Table := Component_Map.Nil; -- The map of component -> component attributes for all components -- in the graph. end record; - -------------- - -- Instance -- - -------------- - - type Instance is access Graph; - Nil : constant Instance := null; + type Directed_Graph is access Directed_Graph_Attributes; + Nil : constant Directed_Graph := null; --------------- -- Iterators -- @@ -520,7 +518,7 @@ package GNAT.Graphs is type Component_Iterator is new Component_Map.Iterator; type Outgoing_Edge_Iterator is new Edge_Set.Iterator; type Vertex_Iterator is new Vertex_List.Iterator; - end Directed_Graph; + end Directed_Graphs; private No_Component : constant Component_Id := Component_Id'First;