[Ada] Implement GNAT.Graphs

This patch introduces new unit GNAT.Graphs which currently provides a
directed graph abstraction.

------------
-- 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_Set
     (Element_Type => Edge_Id,
      "="          => "=",
      Hash         => Hash_Edge);

   package DG is new Directed_Graph
     (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_Set
     (Element_Type => Vertex_Id,
      "="          => "=",
      Hash         => Hash_Vertex);

   -----------------------
   -- Local subprograms --
   -----------------------

   procedure Check_Belongs_To_Component
     (R        : String;
      G        : Instance;
      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 : Instance;
      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     : Instance;
      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      : Instance;
      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 : Instance;
      E : Edge_Id);
   --  Verify that graph G contains edge E. R is the calling routine.

   procedure Check_Has_Vertex
     (R : String;
      G : Instance;
      V : Vertex_Id);
   --  Verify that graph G contains vertex V. R is the calling routine.

   procedure Check_No_Component
     (R : String;
      G : Instance;
      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      : Instance;
      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 : Instance;
      E : Edge_Id);
   --  Verify that graph G does not contain edge E. R is the calling routine.

   procedure Check_No_Vertex
     (R : String;
      G : Instance;
      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       : Instance;
      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       : Instance;
      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       : Instance;
      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   : Instance;
      V   : Vertex_Id;
      Set : ES.Instance);
   --  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     : Instance;
      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    : Instance;
      Comp : Component_Id;
      Set  : VS.Instance);
   --  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 Instance;
   --  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        : Instance;
      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 : Instance;
      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     : Instance;
      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      : Instance;
      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 : Instance;
      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 : Instance;
      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 : Instance;
      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      : Instance;
      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 : Instance;
      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 : Instance;
      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       : Instance;
      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       : Instance;
      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       : Instance;
      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   : Instance;
      V   : Vertex_Id;
      Set : ES.Instance)
   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     : Instance;
      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    : Instance;
      Comp : Component_Id;
      Set  : VS.Instance)
   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 Instance is
      G : constant Instance :=
            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 : Instance := 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 : Instance := 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 : Instance := Create_And_Populate;

      All_E_Iter : All_Edge_Iterator;
      All_Edges  : ES.Instance;

   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 : Instance := Create_And_Populate;
      V : Vertex_Id;

      All_V_Iter   : All_Vertex_Iterator;
      All_Vertices : VS.Instance;

   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 : Instance := 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 : Instance := 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 : Instance := Create (Initial_Vertices => 2, Initial_Edges => 2);
      G2 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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   : Instance := Create_And_Populate;
      Set : ES.Instance;

   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 : Instance := 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 : Instance := 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   : Instance := Create_And_Populate;
      Set : VS.Instance;

   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  <kirtchev@adacore.com>

gcc/ada/

	* impunit.adb: Add GNAT.Graphs to list Non_Imp_File_Names_95.
	* Makefile.rtl, gcc-interface/Make-lang.in: Register unit
	GNAT.Graphs.
	* libgnat/g-dynhta.adb: Various minor cleanups (use Present
	rather than direct comparisons).
	(Delete): Reimplement to use Delete_Node.
	(Delete_Node): New routine.
	(Destroy_Bucket): Invoke the provided destructor.
	(Present): New routines.
	* libgnat/g-dynhta.ads: Add new generic formal Destroy_Value.
	Use better names for the components of iterators.
	* libgnat/g-graphs.adb, libgnat/g-graphs.ads: New unit.
	* libgnat/g-lists.adb: Various minor cleanups (use Present
	rather than direct comparisons).
	(Delete_Node): Invoke the provided destructor.
	(Present): New routine.
	* libgnat/g-lists.ads: Add new generic formal Destroy_Element.
	Use better names for the components of iterators.
	(Present): New routine.
	* libgnat/g-sets.adb, libgnat/g-sets.ads (Destroy, Preset,
	Reset): New routines.

From-SVN: r272857

gcc/ada/ChangeLog

+2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* impunit.adb: Add GNAT.Graphs to list Non_Imp_File_Names_95.
+	* Makefile.rtl, gcc-interface/Make-lang.in: Register unit
+	GNAT.Graphs.
+	* libgnat/g-dynhta.adb: Various minor cleanups (use Present
+	rather than direct comparisons).
+	(Delete): Reimplement to use Delete_Node.
+	(Delete_Node): New routine.
+	(Destroy_Bucket): Invoke the provided destructor.
+	(Present): New routines.
+	* libgnat/g-dynhta.ads: Add new generic formal Destroy_Value.
+	Use better names for the components of iterators.
+	* libgnat/g-graphs.adb, libgnat/g-graphs.ads: New unit.
+	* libgnat/g-lists.adb: Various minor cleanups (use Present
+	rather than direct comparisons).
+	(Delete_Node): Invoke the provided destructor.
+	(Present): New routine.
+	* libgnat/g-lists.ads: Add new generic formal Destroy_Element.
+	Use better names for the components of iterators.
+	(Present): New routine.
+	* libgnat/g-sets.adb, libgnat/g-sets.ads (Destroy, Preset,
+	Reset): New routines.
+
 2019-07-01  Dmitriy Anisimkov  <anisimko@adacore.com>
 
 	* libgnat/g-sothco.adb (Get_Address): Fix the case when AF_INET6

gcc/ada/Makefile.rtl

@@ -421,6 +421,7 @@ GNATRTL_NONTASKING_OBJS= \
   g-exptty$(objext) \
   g-flocon$(objext) \
   g-forstr$(objext) \
+  g-graphs$(objext) \
   g-heasor$(objext) \
   g-hesora$(objext) \
   g-hesorg$(objext) \

gcc/ada/gcc-interface/Make-lang.in

@@ -317,6 +317,7 @@ GNAT_ADA_OBJS =	\
  ada/frontend.o	\
  ada/libgnat/g-byorma.o	\
  ada/libgnat/g-dynhta.o	\
+ ada/libgnat/g-graphs.o \
  ada/libgnat/g-hesora.o	\
  ada/libgnat/g-htable.o	\
  ada/libgnat/g-lists.o \

gcc/ada/impunit.adb

@@ -275,6 +275,7 @@ package body Impunit is
     ("g-exptty", F),  -- GNAT.Expect.TTY
     ("g-flocon", F),  -- GNAT.Float_Control
     ("g-forstr", F),  -- GNAT.Formatted_String
+    ("g-graphs", F),  -- GNAT.Graphs
     ("g-heasor", F),  -- GNAT.Heap_Sort
     ("g-hesora", F),  -- GNAT.Heap_Sort_A
     ("g-hesorg", F),  -- GNAT.Heap_Sort_G

gcc/ada/libgnat/g-dynhta.ads

@@ -265,9 +265,9 @@ package GNAT.Dynamic_HTables is
    --  The following package offers a hash table abstraction with the following
    --  characteristics:
    --
-   --    * Dynamic resizing based on load factor.
-   --    * Creation of multiple instances, of different sizes.
-   --    * Iterable keys.
+   --    * Dynamic resizing based on load factor
+   --    * Creation of multiple instances, of different sizes
+   --    * Iterable keys
    --
    --  This type of hash table is best used in scenarios where the size of the
    --  key set is not known. The dynamic resizing aspect allows for performance
@@ -327,6 +327,9 @@ package GNAT.Dynamic_HTables is
              (Left  : Key_Type;
               Right : Key_Type) return Boolean;
 
+      with procedure Destroy_Value (Val : in out Value_Type);
+      --  Value destructor
+
       with function Hash (Key : Key_Type) return Bucket_Range_Type;
       --  Map an arbitrary key into the range of buckets
 
@@ -366,6 +369,9 @@ package GNAT.Dynamic_HTables is
       function Is_Empty (T : Instance) return Boolean;
       --  Determine whether hash table T is empty
 
+      function Present (T : Instance) return Boolean;
+      --  Determine whether hash table T exists
+
       procedure Put (T : Instance; Key : Key_Type; Value : Value_Type);
       --  Associate value Value with key Key in hash table T. If the table
       --  already contains a mapping of the same key to a previous value, the
@@ -401,15 +407,15 @@ package GNAT.Dynamic_HTables is
 
       type Iterator is private;
 
-      function Iterate (T : Instance) return Iterator;
-      --  Obtain an iterator over the keys of hash table T. This action locks
-      --  all mutation functionality of the associated hash table.
-
       function Has_Next (Iter : Iterator) return Boolean;
       --  Determine whether iterator Iter has more keys to examine. If the
       --  iterator has been exhausted, restore all mutation functionality of
       --  the associated hash table.
 
+      function Iterate (T : Instance) return Iterator;
+      --  Obtain an iterator over the keys of hash table T. This action locks
+      --  all mutation functionality of the associated hash table.
+
       procedure Next (Iter : in out Iterator; Key : out Key_Type);
       --  Return the current key referenced by iterator Iter and advance to
       --  the next available key. If the iterator has been exhausted and
@@ -475,11 +481,11 @@ package GNAT.Dynamic_HTables is
       --  The following type represents a key iterator
 
       type Iterator is record
-         Idx : Bucket_Range_Type := 0;
+         Curr_Idx : Bucket_Range_Type := 0;
          --  Index of the current bucket being examined. This index is always
          --  kept within the range of the buckets.
 
-         Nod : Node_Ptr := null;
+         Curr_Nod : Node_Ptr := null;
          --  Reference to the current node being examined within the current
          --  bucket. The invariant of the iterator requires that this field
          --  always point to a valid node. A value of null indicates that the

gcc/ada/libgnat/g-lists.adb

@@ -90,6 +90,10 @@ package body GNAT.Lists is
       pragma Inline (Lock);
       --  Lock all mutation functionality of list L
 
+      function Present (Nod : Node_Ptr) return Boolean;
+      pragma Inline (Present);
+      --  Determine whether node Nod exists
+
       procedure Unlock (L : Instance);
       pragma Inline (Unlock);
       --  Unlock all mutation functionality of list L
@@ -217,15 +221,15 @@ package body GNAT.Lists is
       procedure Delete_Node (L : Instance; Nod : Node_Ptr) is
          Ref : Node_Ptr := Nod;
 
-         pragma Assert (Ref /= null);
+         pragma Assert (Present (Ref));
 
          Next : constant Node_Ptr := Ref.Next;
          Prev : constant Node_Ptr := Ref.Prev;
 
       begin
-         pragma Assert (L    /= null);
-         pragma Assert (Next /= null);
-         pragma Assert (Prev /= null);
+         pragma Assert (Present (L));
+         pragma Assert (Present (Next));
+         pragma Assert (Present (Prev));
 
          Prev.Next := Next;  --  Prev ---> Next
          Next.Prev := Prev;  --  Prev <--> Next
@@ -235,6 +239,10 @@ package body GNAT.Lists is
 
          L.Elements := L.Elements - 1;
 
+         --  Invoke the element destructor before deallocating the node
+
+         Destroy_Element (Nod.Elem);
+
          Free (Ref);
       end Delete_Node;
 
@@ -263,10 +271,10 @@ package body GNAT.Lists is
       ---------------------
 
       procedure Ensure_Circular (Head : Node_Ptr) is
-         pragma Assert (Head /= null);
+         pragma Assert (Present (Head));
 
       begin
-         if Head.Next = null and then Head.Prev = null then
+         if not Present (Head.Next) and then not Present (Head.Prev) then
             Head.Next := Head;
             Head.Prev := Head;
          end if;
@@ -278,7 +286,7 @@ package body GNAT.Lists is
 
       procedure Ensure_Created (L : Instance) is
       begin
-         if L = null then
+         if not Present (L) then
             raise Not_Created;
          end if;
       end Ensure_Created;
@@ -289,7 +297,7 @@ package body GNAT.Lists is
 
       procedure Ensure_Full (L : Instance) is
       begin
-         pragma Assert (L /= null);
+         pragma Assert (Present (L));
 
          if L.Elements = 0 then
             raise List_Empty;
@@ -302,7 +310,7 @@ package body GNAT.Lists is
 
       procedure Ensure_Unlocked (L : Instance) is
       begin
-         pragma Assert (L /= null);
+         pragma Assert (Present (L));
 
          --  The list has at least one outstanding iterator
 
@@ -319,7 +327,7 @@ package body GNAT.Lists is
         (Head : Node_Ptr;
          Elem : Element_Type) return Node_Ptr
       is
-         pragma Assert (Head /= null);
+         pragma Assert (Present (Head));
 
          Nod : Node_Ptr;
 
@@ -435,9 +443,9 @@ package body GNAT.Lists is
          Left  : Node_Ptr;
          Right : Node_Ptr)
       is
-         pragma Assert (L     /= null);
-         pragma Assert (Left  /= null);
-         pragma Assert (Right /= null);
+         pragma Assert (Present (L));
+         pragma Assert (Present (Left));
+         pragma Assert (Present (Right));
 
          Nod : constant Node_Ptr :=
                  new Node'(Elem => Elem,
@@ -471,7 +479,7 @@ package body GNAT.Lists is
          --  The invariant of Iterate and Next ensures that the iterator always
          --  refers to a valid node if there exists one.
 
-         return Is_Valid (Iter.Nod, Iter.List.Nodes'Access);
+         return Is_Valid (Iter.Curr_Nod, Iter.List.Nodes'Access);
       end Is_Valid;
 
       --------------
@@ -483,7 +491,7 @@ package body GNAT.Lists is
          --  A node is valid if it is non-null, and does not refer to the dummy
          --  head of some list.
 
-         return Nod /= null and then Nod /= Head;
+         return Present (Nod) and then Nod /= Head;
       end Is_Valid;
 
       -------------
@@ -499,7 +507,7 @@ package body GNAT.Lists is
 
          Lock (L);
 
-         return (List => L, Nod => L.Nodes.Next);
+         return (List => L, Curr_Nod => L.Nodes.Next);
       end Iterate;
 
       ----------
@@ -520,7 +528,7 @@ package body GNAT.Lists is
 
       procedure Lock (L : Instance) is
       begin
-         pragma Assert (L /= null);
+         pragma Assert (Present (L));
 
          --  The list may be locked multiple times if multiple iterators are
          --  operating over it.
@@ -534,7 +542,7 @@ package body GNAT.Lists is
 
       procedure Next (Iter : in out Iterator; Elem : out Element_Type) is
          Is_OK : constant Boolean  := Is_Valid (Iter);
-         Saved : constant Node_Ptr := Iter.Nod;
+         Saved : constant Node_Ptr := Iter.Curr_Nod;
 
       begin
          --  The iterator is no linger valid which indicates that it has been
@@ -548,8 +556,9 @@ package body GNAT.Lists is
 
          --  Advance to the next node along the list
 
-         Iter.Nod := Iter.Nod.Next;
-         Elem     := Saved.Elem;
+         Iter.Curr_Nod := Iter.Curr_Nod.Next;
+
+         Elem := Saved.Elem;
       end Next;
 
       -------------
@@ -580,6 +589,24 @@ package body GNAT.Lists is
       end Prepend;
 
       -------------
+      -- Present --
+      -------------
+
+      function Present (L : Instance) return Boolean is
+      begin
+         return L /= Nil;
+      end Present;
+
+      -------------
+      -- Present --
+      -------------
+
+      function Present (Nod : Node_Ptr) return Boolean is
+      begin
+         return Nod /= null;
+      end Present;
+
+      -------------
       -- Replace --
       -------------
 
@@ -620,7 +647,7 @@ package body GNAT.Lists is
 
       procedure Unlock (L : Instance) is
       begin
-         pragma Assert (L /= null);
+         pragma Assert (Present (L));
 
          --  The list may be locked multiple times if multiple iterators are
          --  operating over it.

gcc/ada/libgnat/g-lists.ads

@@ -40,8 +40,8 @@ package GNAT.Lists is
    --  The following package offers a doubly linked list abstraction with the
    --  following characteristics:
    --
-   --    * Creation of multiple instances, of different sizes.
-   --    * Iterable elements.
+   --    * Creation of multiple instances, of different sizes
+   --    * Iterable elements
    --
    --  The following use pattern must be employed with this list:
    --
@@ -60,6 +60,9 @@ package GNAT.Lists is
         (Left  : Element_Type;
          Right : Element_Type) return Boolean;
 
+      with procedure Destroy_Element (Elem : in out Element_Type);
+      --  Element destructor
+
    package Doubly_Linked_List is
 
       ---------------------
@@ -139,6 +142,9 @@ package GNAT.Lists is
       --  Insert element Elem at the start of list L. This action will raise
       --  Iterated if the list has outstanding iterators.
 
+      function Present (L : Instance) return Boolean;
+      --  Determine whether list L exists
+
       procedure Replace
         (L        : Instance;
          Old_Elem : Element_Type;
@@ -168,15 +174,15 @@ package GNAT.Lists is
 
       type Iterator is private;
 
-      function Iterate (L : Instance) return Iterator;
-      --  Obtain an iterator over the elements of list L. This action locks all
-      --  mutation functionality of the associated list.
-
       function Has_Next (Iter : Iterator) return Boolean;
       --  Determine whether iterator Iter has more elements to examine. If the
       --  iterator has been exhausted, restore all mutation functionality of
       --  the associated list.
 
+      function Iterate (L : Instance) return Iterator;
+      --  Obtain an iterator over the elements of list L. This action locks all
+      --  mutation functionality of the associated list.
+
       procedure Next (Iter : in out Iterator; Elem : out Element_Type);
       --  Return the current element referenced by iterator Iter and advance
       --  to the next available element. If the iterator has been exhausted
@@ -215,13 +221,13 @@ package GNAT.Lists is
       --  The following type represents an element iterator
 
       type Iterator is record
-         List : Instance := null;
-         --  Reference to the associated list
-
-         Nod : Node_Ptr := null;
+         Curr_Nod : Node_Ptr := null;
          --  Reference to the current node being examined. The invariant of the
          --  iterator requires that this field always points to a valid node. A
          --  value of null indicates that the iterator is exhausted.
+
+         List : Instance := null;
+         --  Reference to the associated list
       end record;
    end Doubly_Linked_List;
 

gcc/ada/libgnat/g-sets.adb

@@ -68,6 +68,16 @@ package body GNAT.Sets is
       -- Destroy --
       -------------
 
+      procedure Destroy (B : in out Boolean) is
+         pragma Unreferenced (B);
+      begin
+         null;
+      end Destroy;
+
+      -------------
+      -- Destroy --
+      -------------
+
       procedure Destroy (S : in out Instance) is
       begin
          Hashed_Set.Destroy (Hashed_Set.Instance (S));
@@ -118,6 +128,24 @@ package body GNAT.Sets is
          Hashed_Set.Next (Hashed_Set.Iterator (Iter), Elem);
       end Next;
 
+      -------------
+      -- Present --
+      -------------
+
+      function Present (S : Instance) return Boolean is
+      begin
+         return Hashed_Set.Present (Hashed_Set.Instance (S));
+      end Present;
+
+      -----------
+      -- Reset --
+      -----------
+
+      procedure Reset (S : Instance) is
+      begin
+         Hashed_Set.Reset (Hashed_Set.Instance (S));
+      end Reset;
+
       ----------
       -- Size --
       ----------

gcc/ada/libgnat/g-sets.ads

@@ -42,8 +42,8 @@ package GNAT.Sets is
    --  The following package offers a membership set abstraction with the
    --  following characteristics:
    --
-   --    * Creation of multiple instances, of different sizes.
-   --    * Iterable elements.
+   --    * Creation of multiple instances, of different sizes
+   --    * Iterable elements
    --
    --  The following use pattern must be employed with this set:
    --
@@ -103,6 +103,14 @@ package GNAT.Sets is
       function Is_Empty (S : Instance) return Boolean;
       --  Determine whether set S is empty
 
+      function Present (S : Instance) return Boolean;
+      --  Determine whether set S exists
+
+      procedure Reset (S : Instance);
+      --  Destroy the contents of membership set S, and reset it to its initial
+      --  created state. This action will raise Iterated if the membership set
+      --  has outstanding iterators.
+
       function Size (S : Instance) return Natural;
       --  Obtain the number of elements in membership set S
 
@@ -141,6 +149,9 @@ package GNAT.Sets is
       --  raises Iterator_Exhausted.
 
    private
+      procedure Destroy (B : in out Boolean);
+      --  Destroy boolean B
+
       package Hashed_Set is new Dynamic_HTable
         (Key_Type              => Element_Type,
          Value_Type            => Boolean,
@@ -150,6 +161,7 @@ package GNAT.Sets is
          Compression_Threshold => 0.3,
          Compression_Factor    => 2,
          "="                   => "=",
+         Destroy_Value         => Destroy,
          Hash                  => Hash);
 
       type Instance is new Hashed_Set.Instance;