[Ada] Clean up of GNAT.Lists

------------
-- Source --
------------

--  operations.adb

with Ada.Text_IO; use Ada.Text_IO;
with GNAT;        use GNAT;
with GNAT.Lists;  use GNAT.Lists;

procedure Operations is
   procedure Destroy (Val : in out Integer) is null;

   package Integer_Lists is new Doubly_Linked_Lists
     (Element_Type    => Integer,
      "="             => "=",
      Destroy_Element => Destroy);
   use Integer_Lists;

   procedure Check_Empty
     (Caller    : String;
      L         : Doubly_Linked_List;
      Low_Elem  : Integer;
      High_Elem : Integer);
   --  Ensure that none of the elements in the range Low_Elem .. High_Elem are
   --  present in list L, and that the list's length is 0.

   procedure Check_Locked_Mutations
     (Caller : String;
      L      : in out Doubly_Linked_List);
   --  Ensure that all mutation operations of list L are locked

   procedure Check_Present
     (Caller    : String;
      L         : Doubly_Linked_List;
      Low_Elem  : Integer;
      High_Elem : Integer);
   --  Ensure that all elements in the range Low_Elem .. High_Elem are present
   --  in list L.

   procedure Check_Unlocked_Mutations
     (Caller : String;
      L      : in out Doubly_Linked_List);
   --  Ensure that all mutation operations of list L are unlocked

   procedure Populate_With_Append
     (L         : Doubly_Linked_List;
      Low_Elem  : Integer;
      High_Elem : Integer);
   --  Add elements in the range Low_Elem .. High_Elem in that order in list L

   procedure Test_Append;
   --  Verify that Append properly inserts at the tail of a list

   procedure Test_Contains
     (Low_Elem  : Integer;
      High_Elem : Integer);
   --  Verify that Contains properly identifies that elements in the range
   --  Low_Elem .. High_Elem are within a list.

   procedure Test_Create;
   --  Verify that all list operations fail on a non-created list

   procedure Test_Delete
     (Low_Elem  : Integer;
      High_Elem : Integer);
   --  Verify that Delete properly removes elements in the range Low_Elem ..
   --  High_Elem from a list.

   procedure Test_Delete_First
     (Low_Elem  : Integer;
      High_Elem : Integer);
   --  Verify that Delete properly removes elements in the range Low_Elem ..
   --  High_Elem from the head of a list.

   procedure Test_Delete_Last
     (Low_Elem  : Integer;
      High_Elem : Integer);
   --  Verify that Delete properly removes elements in the range Low_Elem ..
   --  High_Elem from the tail of a list.

   procedure Test_First;
   --  Verify that First properly returns the head of a list

   procedure Test_Insert_After;
   --  Verify that Insert_After properly adds an element after some other
   --  element.

   procedure Test_Insert_Before;
   --  Vefity that Insert_Before properly adds an element before some other
   --  element.

   procedure Test_Is_Empty;
   --  Verify that Is_Empty properly returns this status of a list

   procedure Test_Iterate;
   --  Verify that iterators properly manipulate mutation operations

   procedure Test_Iterate_Empty;
   --  Verify that iterators properly manipulate mutation operations of an
   --  empty list.

   procedure Test_Iterate_Forced
     (Low_Elem  : Integer;
      High_Elem : Integer);
   --  Verify that an iterator that is forcefully advanced by Next properly
   --  unlocks the mutation operations of a list.

   procedure Test_Last;
   --  Verify that Last properly returns the tail of a list

   procedure Test_Prepend;
   --  Verify that Prepend properly inserts at the head of a list

   procedure Test_Present;
   --  Verify that Present properly detects a list

   procedure Test_Replace;
   --  Verify that Replace properly substitutes old elements with new ones

   procedure Test_Size;
   --  Verify that Size returns the correct size of a list

   -----------------
   -- Check_Empty --
   -----------------

   procedure Check_Empty
     (Caller    : String;
      L         : Doubly_Linked_List;
      Low_Elem  : Integer;
      High_Elem : Integer)
   is
      Len : constant Natural := Size (L);

   begin
      for Elem in Low_Elem .. High_Elem loop
         if Contains (L, Elem) then
            Put_Line ("ERROR: " & Caller & ": extra element" & Elem'Img);
         end if;
      end loop;

      if Len /= 0 then
         Put_Line ("ERROR: " & Caller & ": wrong length");
         Put_Line ("expected: 0");
         Put_Line ("got     :" & Len'Img);
      end if;
   end Check_Empty;

   ----------------------------
   -- Check_Locked_Mutations --
   ----------------------------

   procedure Check_Locked_Mutations
     (Caller : String;
      L      : in out Doubly_Linked_List)
   is
   begin
      begin
         Append (L, 1);
         Put_Line ("ERROR: " & Caller & ": Append: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Append: unexpected exception");
      end;

      begin
         Delete (L, 1);
         Put_Line ("ERROR: " & Caller & ": Delete: no exception raised");
      exception
         when List_Empty =>
            null;
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
      end;

      begin
         Delete_First (L);
         Put_Line ("ERROR: " & Caller & ": Delete_First: no exception raised");
      exception
         when List_Empty =>
            null;
         when Iterated =>
            null;
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Delete_First: unexpected exception");
      end;

      begin
         Delete_Last (L);
         Put_Line ("ERROR: " & Caller & ": Delete_List: no exception raised");
      exception
         when List_Empty =>
            null;
         when Iterated =>
            null;
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Delete_Last: unexpected exception");
      end;

      begin
         Destroy (L);
         Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception");
      end;

      begin
         Insert_After (L, 1, 2);
         Put_Line ("ERROR: " & Caller & ": Insert_After: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Insert_After: unexpected exception");
      end;

      begin
         Insert_Before (L, 1, 2);
         Put_Line
           ("ERROR: " & Caller & ": Insert_Before: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Insert_Before: unexpected exception");
      end;

      begin
         Prepend (L, 1);
         Put_Line ("ERROR: " & Caller & ": Prepend: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Prepend: unexpected exception");
      end;

      begin
         Replace (L, 1, 2);
         Put_Line ("ERROR: " & Caller & ": Replace: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Replace: unexpected exception");
      end;
   end Check_Locked_Mutations;

   -------------------
   -- Check_Present --
   -------------------

   procedure Check_Present
     (Caller    : String;
      L         : Doubly_Linked_List;
      Low_Elem  : Integer;
      High_Elem : Integer)
   is
      Elem : Integer;
      Iter : Iterator;

   begin
      Iter := Iterate (L);
      for Exp_Elem in Low_Elem .. High_Elem loop
         Next (Iter, Elem);

         if Elem /= Exp_Elem then
            Put_Line ("ERROR: " & Caller & ": Check_Present: wrong element");
            Put_Line ("expected:" & Exp_Elem'Img);
            Put_Line ("got     :" & Elem'Img);
         end if;
      end loop;

      --  At this point all elements should have been accounted for. Check for
      --  extra elements.

      while Has_Next (Iter) loop
         Next (Iter, Elem);
         Put_Line
           ("ERROR: " & Caller & ": Check_Present: extra element" & Elem'Img);
      end loop;

   exception
      when Iterator_Exhausted =>
         Put_Line
           ("ERROR: "
            & Caller
            & "Check_Present: incorrect number of elements");
   end Check_Present;

   ------------------------------
   -- Check_Unlocked_Mutations --
   ------------------------------

   procedure Check_Unlocked_Mutations
     (Caller : String;
      L      : in out Doubly_Linked_List)
   is
   begin
      begin
         Append (L, 1);
         Append (L, 2);
         Append (L, 3);
      exception
         when others =>
            Put_Line ("ERROR: " & Caller & ": Append: unexpected exception");
      end;

      begin
         Delete (L, 1);
      exception
         when others =>
            Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
      end;

      begin
         Delete_First (L);
      exception
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Delete_First: unexpected exception");
      end;

      begin
         Delete_Last (L);
      exception
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Delete_Last: unexpected exception");
      end;

      begin
         Insert_After (L, 2, 3);
      exception
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Insert_After: unexpected exception");
      end;

      begin
         Insert_Before (L, 2, 1);
      exception
         when others =>
            Put_Line
              ("ERROR: " & Caller & ": Insert_Before: unexpected exception");
      end;

      begin
         Prepend (L, 0);
      exception
         when others =>
            Put_Line ("ERROR: " & Caller & ": Prepend: unexpected exception");
      end;

      begin
         Replace (L, 3, 4);
      exception
         when others =>
            Put_Line ("ERROR: " & Caller & ": Replace: unexpected exception");
      end;
   end Check_Unlocked_Mutations;

   --------------------------
   -- Populate_With_Append --
   --------------------------

   procedure Populate_With_Append
     (L         : Doubly_Linked_List;
      Low_Elem  : Integer;
      High_Elem : Integer)
   is
   begin
      for Elem in Low_Elem .. High_Elem loop
         Append (L, Elem);
      end loop;
   end Populate_With_Append;

   -----------------
   -- Test_Append --
   -----------------

   procedure Test_Append is
      L : Doubly_Linked_List := Create;

   begin
      Append (L, 1);
      Append (L, 2);
      Append (L, 3);
      Append (L, 4);
      Append (L, 5);

      Check_Present
        (Caller    => "Test_Append",
         L         => L,
         Low_Elem  => 1,
         High_Elem => 5);

      Destroy (L);
   end Test_Append;

   -------------------
   -- Test_Contains --
   -------------------

   procedure Test_Contains
     (Low_Elem  : Integer;
      High_Elem : Integer)
   is
      Low_Bogus  : constant Integer := Low_Elem  - 1;
      High_Bogus : constant Integer := High_Elem + 1;

      L : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, Low_Elem, High_Elem);

      --  Ensure that the elements are contained in the list

      for Elem in Low_Elem .. High_Elem loop
         if not Contains (L, Elem) then
            Put_Line
              ("ERROR: Test_Contains: element" & Elem'Img & " not in list");
         end if;
      end loop;

      --  Ensure that arbitrary elements which were not inserted in the list
      --  are not contained in the list.

      if Contains (L, Low_Bogus) then
         Put_Line
           ("ERROR: Test_Contains: element" & Low_Bogus'Img & " in list");
      end if;

      if Contains (L, High_Bogus) then
         Put_Line
           ("ERROR: Test_Contains: element" & High_Bogus'Img & " in list");
      end if;

      Destroy (L);
   end Test_Contains;

   -----------------
   -- Test_Create --
   -----------------

   procedure Test_Create is
      Count : Natural;
      Flag  : Boolean;
      Iter  : Iterator;
      L     : Doubly_Linked_List;
      Val   : Integer;

   begin
      --  Ensure that every routine defined in the API fails on a list which
      --  has not been created yet.

      begin
         Append (L, 1);
         Put_Line ("ERROR: Test_Create: Append: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Append: unexpected exception");
      end;

      begin
         Flag := Contains (L, 1);
         Put_Line ("ERROR: Test_Create: Contains: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Contains: unexpected exception");
      end;

      begin
         Delete (L, 1);
         Put_Line ("ERROR: Test_Create: Delete: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Delete: unexpected exception");
      end;

      begin
         Delete_First (L);
         Put_Line ("ERROR: Test_Create: Delete_First: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line
              ("ERROR: Test_Create: Delete_First: unexpected exception");
      end;

      begin
         Delete_Last (L);
         Put_Line ("ERROR: Test_Create: Delete_Last: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Delete_Last: unexpected exception");
      end;

      begin
         Val := First (L);
         Put_Line ("ERROR: Test_Create: First: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: First: unexpected exception");
      end;

      begin
         Insert_After (L, 1, 2);
         Put_Line ("ERROR: Test_Create: Insert_After: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line
              ("ERROR: Test_Create: Insert_After: unexpected exception");
      end;

      begin
         Insert_Before (L, 1, 2);
         Put_Line ("ERROR: Test_Create: Insert_Before: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line
              ("ERROR: Test_Create: Insert_Before: unexpected exception");
      end;

      begin
         Flag := Is_Empty (L);
         Put_Line ("ERROR: Test_Create: Is_Empty: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Is_Empty: unexpected exception");
      end;

      begin
         Iter := Iterate (L);
         Put_Line ("ERROR: Test_Create: Iterate: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Iterate: unexpected exception");
      end;

      begin
         Val := Last (L);
         Put_Line ("ERROR: Test_Create: Last: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Last: unexpected exception");
      end;

      begin
         Prepend (L, 1);
         Put_Line ("ERROR: Test_Create: Prepend: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Prepend: unexpected exception");
      end;

      begin
         Replace (L, 1, 2);
         Put_Line ("ERROR: Test_Create: Replace: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Replace: unexpected exception");
      end;

      begin
         Count := Size (L);
         Put_Line ("ERROR: Test_Create: Size: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Size: unexpected exception");
      end;
   end Test_Create;

   -----------------
   -- Test_Delete --
   -----------------

   procedure Test_Delete
     (Low_Elem  : Integer;
      High_Elem : Integer)
   is
      L : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, Low_Elem, High_Elem);

      --  Delete the first element, which is technically the head

      Delete (L, Low_Elem);

      --  Ensure that all remaining elements except for the head are present in
      --  the list.

      Check_Present
        (Caller    => "Test_Delete",
         L         => L,
         Low_Elem  => Low_Elem + 1,
         High_Elem => High_Elem);

      --  Delete the last element, which is technically the tail

      Delete (L, High_Elem);

      --  Ensure that all remaining elements except for the head and tail are
      --  present in the list.

      Check_Present
        (Caller    => "Test_Delete",
         L         => L,
         Low_Elem  => Low_Elem  + 1,
         High_Elem => High_Elem - 1);

      --  Delete all even elements

      for Elem in Low_Elem + 1 .. High_Elem - 1 loop
         if Elem mod 2 = 0 then
            Delete (L, Elem);
         end if;
      end loop;

      --  Ensure that all remaining elements except the head, tail, and even
      --  elements are present in the list.

      for Elem in Low_Elem + 1 .. High_Elem - 1 loop
         if Elem mod 2 /= 0 and then not Contains (L, Elem) then
            Put_Line ("ERROR: Test_Delete: missing element" & Elem'Img);
         end if;
      end loop;

      --  Delete all odd elements

      for Elem in Low_Elem + 1 .. High_Elem - 1 loop
         if Elem mod 2 /= 0 then
            Delete (L, Elem);
         end if;
      end loop;

      --  At this point the list should be completely empty

      Check_Empty
        (Caller    => "Test_Delete",
         L         => L,
         Low_Elem  => Low_Elem,
         High_Elem => High_Elem);

      --  Try to delete an element. This operation should raise List_Empty.

      begin
         Delete (L, Low_Elem);
         Put_Line ("ERROR: Test_Delete: List_Empty not raised");
      exception
         when List_Empty =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Delete: unexpected exception");
      end;

      Destroy (L);
   end Test_Delete;

   -----------------------
   -- Test_Delete_First --
   -----------------------

   procedure Test_Delete_First
     (Low_Elem  : Integer;
      High_Elem : Integer)
   is
      L : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, Low_Elem, High_Elem);

      --  Delete the head of the list, and verify that the remaining elements
      --  are still present in the list.

      for Elem in Low_Elem .. High_Elem loop
         Delete_First (L);

         Check_Present
           (Caller    => "Test_Delete_First",
            L         => L,
            Low_Elem  => Elem + 1,
            High_Elem => High_Elem);
      end loop;

      --  At this point the list should be completely empty

      Check_Empty
        (Caller    => "Test_Delete_First",
         L         => L,
         Low_Elem  => Low_Elem,
         High_Elem => High_Elem);

      --  Try to delete an element. This operation should raise List_Empty.

      begin
         Delete_First (L);
         Put_Line ("ERROR: Test_Delete_First: List_Empty not raised");
      exception
         when List_Empty =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Delete_First: unexpected exception");
      end;

      Destroy (L);
   end Test_Delete_First;

   ----------------------
   -- Test_Delete_Last --
   ----------------------

   procedure Test_Delete_Last
     (Low_Elem  : Integer;
      High_Elem : Integer)
   is
      L : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, Low_Elem, High_Elem);

      --  Delete the tail of the list, and verify that the remaining elements
      --  are still present in the list.

      for Elem in reverse Low_Elem .. High_Elem loop
         Delete_Last (L);

         Check_Present
           (Caller    => "Test_Delete_Last",
            L         => L,
            Low_Elem  => Low_Elem,
            High_Elem => Elem - 1);
      end loop;

      --  At this point the list should be completely empty

      Check_Empty
        (Caller    => "Test_Delete_Last",
         L         => L,
         Low_Elem  => Low_Elem,
         High_Elem => High_Elem);

      --  Try to delete an element. This operation should raise List_Empty.

      begin
         Delete_Last (L);
         Put_Line ("ERROR: Test_Delete_Last: List_Empty not raised");
      exception
         when List_Empty =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Delete_First: unexpected exception");
      end;

      Destroy (L);
   end Test_Delete_Last;

   ----------------
   -- Test_First --
   ----------------

   procedure Test_First is
      Elem : Integer;
      L    : Doubly_Linked_List := Create;

   begin
      --  Try to obtain the head. This operation should raise List_Empty.

      begin
         Elem := First (L);
         Put_Line ("ERROR: Test_First: List_Empty not raised");
      exception
         when List_Empty =>
            null;
         when others =>
            Put_Line ("ERROR: Test_First: unexpected exception");
      end;

      Populate_With_Append (L, 1, 2);

      --  Obtain the head

      Elem := First (L);

      if Elem /= 1 then
         Put_Line ("ERROR: Test_First: wrong element");
         Put_Line ("expected: 1");
         Put_Line ("got     :" & Elem'Img);
      end if;

      Destroy (L);
   end Test_First;

   -----------------------
   -- Test_Insert_After --
   -----------------------

   procedure Test_Insert_After is
      L : Doubly_Linked_List := Create;

   begin
      --  Try to insert after a non-inserted element, in an empty list

      Insert_After (L, 1, 2);

      --  At this point the list should be completely empty

      Check_Empty
        (Caller    => "Test_Insert_After",
         L         => L,
         Low_Elem  => 0,
         High_Elem => -1);

      Append (L, 1);           --  1

      Insert_After (L, 1, 3);  --  1, 3
      Insert_After (L, 1, 2);  --  1, 2, 3
      Insert_After (L, 3, 4);  --  1, 2, 3, 4

      --  Try to insert after a non-inserted element, in a full list

      Insert_After (L, 10, 11);

      Check_Present
        (Caller    => "Test_Insert_After",
         L         => L,
         Low_Elem  => 1,
         High_Elem => 4);

      Destroy (L);
   end Test_Insert_After;

   ------------------------
   -- Test_Insert_Before --
   ------------------------

   procedure Test_Insert_Before is
      L : Doubly_Linked_List := Create;

   begin
      --  Try to insert before a non-inserted element, in an empty list

      Insert_Before (L, 1, 2);

      --  At this point the list should be completely empty

      Check_Empty
        (Caller    => "Test_Insert_Before",
         L         => L,
         Low_Elem  => 0,
         High_Elem => -1);

      Append (L, 4);            --  4

      Insert_Before (L, 4, 2);  --  2, 4
      Insert_Before (L, 2, 1);  --  1, 2, 4
      Insert_Before (L, 4, 3);  --  1, 2, 3, 4

      --  Try to insert before a non-inserted element, in a full list

      Insert_Before (L, 10, 11);

      Check_Present
        (Caller    => "Test_Insert_Before",
         L         => L,
         Low_Elem  => 1,
         High_Elem => 4);

      Destroy (L);
   end Test_Insert_Before;

   -------------------
   -- Test_Is_Empty --
   -------------------

   procedure Test_Is_Empty is
      L : Doubly_Linked_List := Create;

   begin
      if not Is_Empty (L) then
         Put_Line ("ERROR: Test_Is_Empty: list is not empty");
      end if;

      Append (L, 1);

      if Is_Empty (L) then
         Put_Line ("ERROR: Test_Is_Empty: list is empty");
      end if;

      Delete_First (L);

      if not Is_Empty (L) then
         Put_Line ("ERROR: Test_Is_Empty: list is not empty");
      end if;

      Destroy (L);
   end Test_Is_Empty;

   ------------------
   -- Test_Iterate --
   ------------------

   procedure Test_Iterate is
      Elem   : Integer;
      Iter_1 : Iterator;
      Iter_2 : Iterator;
      L      : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, 1, 5);

      --  Obtain an iterator. This action must lock all mutation operations of
      --  the list.

      Iter_1 := Iterate (L);

      --  Ensure that every mutation routine defined in the API fails on a list
      --  with at least one outstanding iterator.

      Check_Locked_Mutations
        (Caller => "Test_Iterate",
         L      => L);

      --  Obtain another iterator

      Iter_2 := Iterate (L);

      --  Ensure that every mutation is still locked

      Check_Locked_Mutations
        (Caller => "Test_Iterate",
         L      => L);

      --  Exhaust the first itertor

      while Has_Next (Iter_1) loop
         Next (Iter_1, Elem);
      end loop;

      --  Ensure that every mutation is still locked

      Check_Locked_Mutations
        (Caller => "Test_Iterate",
         L      => L);

      --  Exhaust the second itertor

      while Has_Next (Iter_2) loop
         Next (Iter_2, Elem);
      end loop;

      --  Ensure that all mutation operations are once again callable

      Check_Unlocked_Mutations
        (Caller => "Test_Iterate",
         L      => L);

      Destroy (L);
   end Test_Iterate;

   ------------------------
   -- Test_Iterate_Empty --
   ------------------------

   procedure Test_Iterate_Empty is
      Elem : Integer;
      Iter : Iterator;
      L    : Doubly_Linked_List := Create;

   begin
      --  Obtain an iterator. This action must lock all mutation operations of
      --  the list.

      Iter := Iterate (L);

      --  Ensure that every mutation routine defined in the API fails on a list
      --  with at least one outstanding iterator.

      Check_Locked_Mutations
        (Caller => "Test_Iterate_Empty",
         L      => L);

      --  Attempt to iterate over the elements

      while Has_Next (Iter) loop
         Next (Iter, Elem);

         Put_Line
           ("ERROR: Test_Iterate_Empty: element" & Elem'Img & " exists");
      end loop;

      --  Ensure that all mutation operations are once again callable

      Check_Unlocked_Mutations
        (Caller => "Test_Iterate_Empty",
         L      => L);

      Destroy (L);
   end Test_Iterate_Empty;

   -------------------------
   -- Test_Iterate_Forced --
   -------------------------

   procedure Test_Iterate_Forced
     (Low_Elem  : Integer;
      High_Elem : Integer)
   is
      Elem : Integer;
      Iter : Iterator;
      L    : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, Low_Elem, High_Elem);

      --  Obtain an iterator. This action must lock all mutation operations of
      --  the list.

      Iter := Iterate (L);

      --  Ensure that every mutation routine defined in the API fails on a list
      --  with at least one outstanding iterator.

      Check_Locked_Mutations
        (Caller => "Test_Iterate_Forced",
         L      => L);

      --  Forcibly advance the iterator until it raises an exception

      begin
         for Guard in Low_Elem .. High_Elem + 1 loop
            Next (Iter, Elem);
         end loop;

         Put_Line
           ("ERROR: Test_Iterate_Forced: Iterator_Exhausted not raised");
      exception
         when Iterator_Exhausted =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Iterate_Forced: unexpected exception");
      end;

      --  Ensure that all mutation operations are once again callable

      Check_Unlocked_Mutations
        (Caller => "Test_Iterate_Forced",
         L      => L);

      Destroy (L);
   end Test_Iterate_Forced;

   ---------------
   -- Test_Last --
   ---------------

   procedure Test_Last is
      Elem : Integer;
      L    : Doubly_Linked_List := Create;

   begin
      --  Try to obtain the tail. This operation should raise List_Empty.

      begin
         Elem := First (L);
         Put_Line ("ERROR: Test_Last: List_Empty not raised");
      exception
         when List_Empty =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Last: unexpected exception");
      end;

      Populate_With_Append (L, 1, 2);

      --  Obtain the tail

      Elem := Last (L);

      if Elem /= 2 then
         Put_Line ("ERROR: Test_Last: wrong element");
         Put_Line ("expected: 2");
         Put_Line ("got     :" & Elem'Img);
      end if;

      Destroy (L);
   end Test_Last;

   ------------------
   -- Test_Prepend --
   ------------------

   procedure Test_Prepend is
      L : Doubly_Linked_List := Create;

   begin
      Prepend (L, 5);
      Prepend (L, 4);
      Prepend (L, 3);
      Prepend (L, 2);
      Prepend (L, 1);

      Check_Present
        (Caller    => "Test_Prepend",
         L         => L,
         Low_Elem  => 1,
         High_Elem => 5);

      Destroy (L);
   end Test_Prepend;

   ------------------
   -- Test_Present --
   ------------------

   procedure Test_Present is
      L : Doubly_Linked_List;

   begin
      if Present (L) then
         Put_Line ("ERROR: Test_Present: list does not exist");
      end if;

      L := Create;

      if not Present (L) then
         Put_Line ("ERROR: Test_Present: list exists");
      end if;

      Destroy (L);
   end Test_Present;

   ------------------
   -- Test_Replace --
   ------------------

   procedure Test_Replace is
      L : Doubly_Linked_List := Create;

   begin
      Populate_With_Append (L, 1, 5);

      Replace (L, 3, 8);
      Replace (L, 1, 6);
      Replace (L, 4, 9);
      Replace (L, 5, 10);
      Replace (L, 2, 7);

      Replace (L, 11, 12);

      Check_Present
        (Caller    => "Test_Replace",
         L         => L,
         Low_Elem  => 6,
         High_Elem => 10);

      Destroy (L);
   end Test_Replace;

   ---------------
   -- Test_Size --
   ---------------

   procedure Test_Size is
      L : Doubly_Linked_List := Create;
      S : Natural;

   begin
      S := Size (L);

      if S /= 0 then
         Put_Line ("ERROR: Test_Size: wrong size");
         Put_Line ("expected: 0");
         Put_Line ("got     :" & S'Img);
      end if;

      Populate_With_Append (L, 1, 2);
      S := Size (L);

      if S /= 2 then
         Put_Line ("ERROR: Test_Size: wrong size");
         Put_Line ("expected: 2");
         Put_Line ("got     :" & S'Img);
      end if;

      Populate_With_Append (L, 3, 6);
      S := Size (L);

      if S /= 6 then
         Put_Line ("ERROR: Test_Size: wrong size");
         Put_Line ("expected: 6");
         Put_Line ("got     :" & S'Img);
      end if;

      Destroy (L);
   end Test_Size;

--  Start of processing for Operations

begin
   Test_Append;

   Test_Contains
     (Low_Elem  => 1,
      High_Elem => 5);

   Test_Create;

   Test_Delete
     (Low_Elem  => 1,
      High_Elem => 10);

   Test_Delete_First
     (Low_Elem  => 1,
      High_Elem => 5);

   Test_Delete_Last
     (Low_Elem  => 1,
      High_Elem => 5);

   Test_First;
   Test_Insert_After;
   Test_Insert_Before;
   Test_Is_Empty;
   Test_Iterate;
   Test_Iterate_Empty;

   Test_Iterate_Forced
     (Low_Elem  => 1,
      High_Elem => 5);

   Test_Last;
   Test_Prepend;
   Test_Present;
   Test_Replace;
   Test_Size;
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/

	* libgnat/g-lists.adb: Use type Doubly_Linked_List rather than
	Instance in various routines.
	* libgnat/g-lists.ads: Change type Instance to
	Doubly_Linked_List. Update various routines that mention the
	type.

gcc/testsuite/

	* gnat.dg/linkedlist.adb: Update.

From-SVN: r272861

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c527b80bc36d473854f936bfd88c031955f41f24..570a04a5c8a2a6ec561f403e6d1b915be526c82a 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,11 @@
+2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * libgnat/g-lists.adb: Use type Doubly_Linked_List rather than
+       Instance in various routines.
+       * libgnat/g-lists.ads: Change type Instance to
+       Doubly_Linked_List. Update various routines that mention the
+       type.
+
 2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * libgnat/g-dynhta.adb: Use type Dynamic_Hash_Table rather than

diff --git a/gcc/ada/libgnat/g-lists.adb b/gcc/ada/libgnat/g-lists.adb
index d1a8616b2e6e13ebd742770ca4e61ad10d94c973..f7447a50d473181abcf189d34e2c5098fd54b927 100644 (file)
--- a/gcc/ada/libgnat/g-lists.adb
+++ b/gcc/ada/libgnat/g-lists.adb
@@ -33,8 +33,10 @@ with Ada.Unchecked_Deallocation;
 
 package body GNAT.Lists is
 
-   package body Doubly_Linked_List is
-      procedure Delete_Node (L : Instance; Nod : Node_Ptr);
+   package body Doubly_Linked_Lists is
+      procedure Delete_Node
+        (L   : Doubly_Linked_List;
+         Nod : Node_Ptr);
       pragma Inline (Delete_Node);
       --  Detach and delete node Nod from list L
 
@@ -42,17 +44,17 @@ package body GNAT.Lists is
       pragma Inline (Ensure_Circular);
       --  Ensure that dummy head Head is circular with respect to itself
 
-      procedure Ensure_Created (L : Instance);
+      procedure Ensure_Created (L : Doubly_Linked_List);
       pragma Inline (Ensure_Created);
       --  Verify that list L is created. Raise Not_Created if this is not the
       --  case.
 
-      procedure Ensure_Full (L : Instance);
+      procedure Ensure_Full (L : Doubly_Linked_List);
       pragma Inline (Ensure_Full);
       --  Verify that list L contains at least one element. Raise List_Empty if
       --  this is not the case.
 
-      procedure Ensure_Unlocked (L : Instance);
+      procedure Ensure_Unlocked (L : Doubly_Linked_List);
       pragma Inline (Ensure_Unlocked);
       --  Verify that list L is unlocked. Raise Iterated if this is not the
       --  case.
@@ -65,12 +67,14 @@ package body GNAT.Lists is
       --  exists a node with element Elem. If such a node exists, return it,
       --  otherwise return null;
 
-      procedure Free is new Ada.Unchecked_Deallocation (Linked_List, Instance);
+      procedure Free is
+        new Ada.Unchecked_Deallocation
+              (Doubly_Linked_List_Attributes, Doubly_Linked_List);
 
       procedure Free is new Ada.Unchecked_Deallocation (Node, Node_Ptr);
 
       procedure Insert_Between
-        (L     : Instance;
+        (L     : Doubly_Linked_List;
          Elem  : Element_Type;
          Left  : Node_Ptr;
          Right : Node_Ptr);
@@ -81,12 +85,14 @@ package body GNAT.Lists is
       pragma Inline (Is_Valid);
       --  Determine whether iterator Iter refers to a valid element
 
-      function Is_Valid (Nod : Node_Ptr; Head : Node_Ptr) return Boolean;
+      function Is_Valid
+        (Nod  : Node_Ptr;
+         Head : Node_Ptr) return Boolean;
       pragma Inline (Is_Valid);
       --  Determine whether node Nod is non-null and does not refer to dummy
       --  head Head, thus making it valid.
 
-      procedure Lock (L : Instance);
+      procedure Lock (L : Doubly_Linked_List);
       pragma Inline (Lock);
       --  Lock all mutation functionality of list L
 
@@ -94,7 +100,7 @@ package body GNAT.Lists is
       pragma Inline (Present);
       --  Determine whether node Nod exists
 
-      procedure Unlock (L : Instance);
+      procedure Unlock (L : Doubly_Linked_List);
       pragma Inline (Unlock);
       --  Unlock all mutation functionality of list L
 
@@ -102,7 +108,10 @@ package body GNAT.Lists is
       -- Append --
       ------------
 
-      procedure Append (L : Instance; Elem : Element_Type) is
+      procedure Append
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type)
+      is
          Head : Node_Ptr;
 
       begin
@@ -129,16 +138,19 @@ package body GNAT.Lists is
       -- Create --
       ------------
 
-      function Create return Instance is
+      function Create return Doubly_Linked_List is
       begin
-         return new Linked_List;
+         return new Doubly_Linked_List_Attributes;
       end Create;
 
       --------------
       -- Contains --
       --------------
 
-      function Contains (L : Instance; Elem : Element_Type) return Boolean is
+      function Contains
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type) return Boolean
+      is
          Head : Node_Ptr;
          Nod  : Node_Ptr;
 
@@ -155,7 +167,10 @@ package body GNAT.Lists is
       -- Delete --
       ------------
 
-      procedure Delete (L : Instance; Elem : Element_Type) is
+      procedure Delete
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type)
+      is
          Head : Node_Ptr;
          Nod  : Node_Ptr;
 
@@ -176,7 +191,7 @@ package body GNAT.Lists is
       -- Delete_First --
       ------------------
 
-      procedure Delete_First (L : Instance) is
+      procedure Delete_First (L : Doubly_Linked_List) is
          Head : Node_Ptr;
          Nod  : Node_Ptr;
 
@@ -197,7 +212,7 @@ package body GNAT.Lists is
       -- Delete_Last --
       -----------------
 
-      procedure Delete_Last (L : Instance) is
+      procedure Delete_Last (L : Doubly_Linked_List) is
          Head : Node_Ptr;
          Nod  : Node_Ptr;
 
@@ -218,7 +233,10 @@ package body GNAT.Lists is
       -- Delete_Node --
       -----------------
 
-      procedure Delete_Node (L : Instance; Nod : Node_Ptr) is
+      procedure Delete_Node
+        (L   : Doubly_Linked_List;
+         Nod : Node_Ptr)
+      is
          Ref : Node_Ptr := Nod;
 
          pragma Assert (Present (Ref));
@@ -250,7 +268,7 @@ package body GNAT.Lists is
       -- Destroy --
       -------------
 
-      procedure Destroy (L : in out Instance) is
+      procedure Destroy (L : in out Doubly_Linked_List) is
          Head : Node_Ptr;
 
       begin
@@ -284,7 +302,7 @@ package body GNAT.Lists is
       -- Ensure_Created --
       --------------------
 
-      procedure Ensure_Created (L : Instance) is
+      procedure Ensure_Created (L : Doubly_Linked_List) is
       begin
          if not Present (L) then
             raise Not_Created;
@@ -295,7 +313,7 @@ package body GNAT.Lists is
       -- Ensure_Full --
       -----------------
 
-      procedure Ensure_Full (L : Instance) is
+      procedure Ensure_Full (L : Doubly_Linked_List) is
       begin
          pragma Assert (Present (L));
 
@@ -308,7 +326,7 @@ package body GNAT.Lists is
       -- Ensure_Unlocked --
       ---------------------
 
-      procedure Ensure_Unlocked (L : Instance) is
+      procedure Ensure_Unlocked (L : Doubly_Linked_List) is
       begin
          pragma Assert (Present (L));
 
@@ -350,7 +368,7 @@ package body GNAT.Lists is
       -- First --
       -----------
 
-      function First (L : Instance) return Element_Type is
+      function First (L : Doubly_Linked_List) return Element_Type is
       begin
          Ensure_Created (L);
          Ensure_Full    (L);
@@ -382,7 +400,7 @@ package body GNAT.Lists is
       ------------------
 
       procedure Insert_After
-        (L     : Instance;
+        (L     : Doubly_Linked_List;
          After : Element_Type;
          Elem  : Element_Type)
       is
@@ -410,7 +428,7 @@ package body GNAT.Lists is
       -------------------
 
       procedure Insert_Before
-        (L      : Instance;
+        (L      : Doubly_Linked_List;
          Before : Element_Type;
          Elem   : Element_Type)
       is
@@ -438,7 +456,7 @@ package body GNAT.Lists is
       --------------------
 
       procedure Insert_Between
-        (L     : Instance;
+        (L     : Doubly_Linked_List;
          Elem  : Element_Type;
          Left  : Node_Ptr;
          Right : Node_Ptr)
@@ -463,7 +481,7 @@ package body GNAT.Lists is
       -- Is_Empty --
       --------------
 
-      function Is_Empty (L : Instance) return Boolean is
+      function Is_Empty (L : Doubly_Linked_List) return Boolean is
       begin
          Ensure_Created (L);
 
@@ -486,7 +504,10 @@ package body GNAT.Lists is
       -- Is_Valid --
       --------------
 
-      function Is_Valid (Nod : Node_Ptr; Head : Node_Ptr) return Boolean is
+      function Is_Valid
+        (Nod  : Node_Ptr;
+         Head : Node_Ptr) return Boolean
+      is
       begin
          --  A node is valid if it is non-null, and does not refer to the dummy
          --  head of some list.
@@ -498,7 +519,7 @@ package body GNAT.Lists is
       -- Iterate --
       -------------
 
-      function Iterate (L : Instance) return Iterator is
+      function Iterate (L : Doubly_Linked_List) return Iterator is
       begin
          Ensure_Created (L);
 
@@ -514,7 +535,7 @@ package body GNAT.Lists is
       -- Last --
       ----------
 
-      function Last (L : Instance) return Element_Type is
+      function Last (L : Doubly_Linked_List) return Element_Type is
       begin
          Ensure_Created (L);
          Ensure_Full   (L);
@@ -526,7 +547,7 @@ package body GNAT.Lists is
       -- Lock --
       ----------
 
-      procedure Lock (L : Instance) is
+      procedure Lock (L : Doubly_Linked_List) is
       begin
          pragma Assert (Present (L));
 
@@ -540,7 +561,10 @@ package body GNAT.Lists is
       -- Next --
       ----------
 
-      procedure Next (Iter : in out Iterator; Elem : out Element_Type) is
+      procedure Next
+        (Iter : in out Iterator;
+         Elem : out Element_Type)
+      is
          Is_OK : constant Boolean  := Is_Valid (Iter);
          Saved : constant Node_Ptr := Iter.Curr_Nod;
 
@@ -565,7 +589,10 @@ package body GNAT.Lists is
       -- Prepend --
       -------------
 
-      procedure Prepend (L : Instance; Elem : Element_Type) is
+      procedure Prepend
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type)
+      is
          Head : Node_Ptr;
 
       begin
@@ -592,7 +619,7 @@ package body GNAT.Lists is
       -- Present --
       -------------
 
-      function Present (L : Instance) return Boolean is
+      function Present (L : Doubly_Linked_List) return Boolean is
       begin
          return L /= Nil;
       end Present;
@@ -611,7 +638,7 @@ package body GNAT.Lists is
       -------------
 
       procedure Replace
-        (L        : Instance;
+        (L        : Doubly_Linked_List;
          Old_Elem : Element_Type;
          New_Elem : Element_Type)
       is
@@ -634,7 +661,7 @@ package body GNAT.Lists is
       -- Size --
       ----------
 
-      function Size (L : Instance) return Natural is
+      function Size (L : Doubly_Linked_List) return Natural is
       begin
          Ensure_Created (L);
 
@@ -645,7 +672,7 @@ package body GNAT.Lists is
       -- Unlock --
       ------------
 
-      procedure Unlock (L : Instance) is
+      procedure Unlock (L : Doubly_Linked_List) is
       begin
          pragma Assert (Present (L));
 
@@ -654,6 +681,6 @@ package body GNAT.Lists is
 
          L.Iterators := L.Iterators - 1;
       end Unlock;
-   end Doubly_Linked_List;
+   end Doubly_Linked_Lists;
 
 end GNAT.Lists;

diff --git a/gcc/ada/libgnat/g-lists.ads b/gcc/ada/libgnat/g-lists.ads
index 911b85f8969d4f749bbf21930f73086693a742bd..b64ef08ddb36ac80e129fd181a88cf9fdac4d490 100644 (file)
--- a/gcc/ada/libgnat/g-lists.ads
+++ b/gcc/ada/libgnat/g-lists.ads
@@ -45,7 +45,7 @@ package GNAT.Lists is
    --
    --  The following use pattern must be employed with this list:
    --
-   --    List : Instance := Create;
+   --    List : Doubly_Linked_List := Create;
    --
    --    <various operations>
    --
@@ -63,60 +63,66 @@ package GNAT.Lists is
       with procedure Destroy_Element (Elem : in out Element_Type);
       --  Element destructor
 
-   package Doubly_Linked_List is
+   package Doubly_Linked_Lists is
 
       ---------------------
       -- List operations --
       ---------------------
 
-      type Instance is private;
-      Nil : constant Instance;
+      type Doubly_Linked_List is private;
+      Nil : constant Doubly_Linked_List;
 
       --  The following exception is raised when the list is empty, and an
       --  attempt is made to delete an element from it.
 
       List_Empty : exception;
 
-      procedure Append (L : Instance; Elem : Element_Type);
+      procedure Append
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type);
       --  Insert element Elem at the end of list L. This action will raise
       --  Iterated if the list has outstanding iterators.
 
-      function Contains (L : Instance; Elem : Element_Type) return Boolean;
+      function Contains
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type) return Boolean;
       --  Determine whether list L contains element Elem
 
-      function Create return Instance;
+      function Create return Doubly_Linked_List;
       --  Create a new list
 
-      procedure Delete (L : Instance; Elem : Element_Type);
+      procedure Delete
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type);
       --  Delete element Elem from list L. The routine has no effect if Elem is
       --  not present. This action will raise
       --
       --    * List_Empty if the list is empty.
       --    * Iterated if the list has outstanding iterators.
 
-      procedure Delete_First (L : Instance);
+      procedure Delete_First (L : Doubly_Linked_List);
       --  Delete an element from the start of list L. This action will raise
       --
       --    * List_Empty if the list is empty.
       --    * Iterated if the list has outstanding iterators.
 
-      procedure Delete_Last (L : Instance);
+      procedure Delete_Last (L : Doubly_Linked_List);
       --  Delete an element from the end of list L. This action will raise
       --
       --    * List_Empty if the list is empty.
       --    * Iterated if the list has outstanding iterators.
 
-      procedure Destroy (L : in out Instance);
+      procedure Destroy (L : in out Doubly_Linked_List);
       --  Destroy the contents of list L. This routine must be called at the
       --  end of a list's lifetime. This action will raise Iterated if the
       --  list has outstanding iterators.
 
-      function First (L : Instance) return Element_Type;
+      function First (L : Doubly_Linked_List) return Element_Type;
       --  Obtain an element from the start of list L. This action will raise
       --  List_Empty if the list is empty.
 
       procedure Insert_After
-        (L     : Instance;
+        (L     : Doubly_Linked_List;
          After : Element_Type;
          Elem  : Element_Type);
       --  Insert new element Elem after element After in list L. The routine
@@ -124,36 +130,38 @@ package GNAT.Lists is
       --  Iterated if the list has outstanding iterators.
 
       procedure Insert_Before
-        (L      : Instance;
+        (L      : Doubly_Linked_List;
          Before : Element_Type;
          Elem   : Element_Type);
       --  Insert new element Elem before element Before in list L. The routine
       --  has no effect if After is not present. This action will raise
       --  Iterated if the list has outstanding iterators.
 
-      function Is_Empty (L : Instance) return Boolean;
+      function Is_Empty (L : Doubly_Linked_List) return Boolean;
       --  Determine whether list L is empty
 
-      function Last (L : Instance) return Element_Type;
+      function Last (L : Doubly_Linked_List) return Element_Type;
       --  Obtain an element from the end of list L. This action will raise
       --  List_Empty if the list is empty.
 
-      procedure Prepend (L : Instance; Elem : Element_Type);
+      procedure Prepend
+        (L    : Doubly_Linked_List;
+         Elem : Element_Type);
       --  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;
+      function Present (L : Doubly_Linked_List) return Boolean;
       --  Determine whether list L exists
 
       procedure Replace
-        (L        : Instance;
+        (L        : Doubly_Linked_List;
          Old_Elem : Element_Type;
          New_Elem : Element_Type);
       --  Replace old element Old_Elem with new element New_Elem in list L. The
       --  routine has no effect if Old_Elem is not present. This action will
       --  raise Iterated if the list has outstanding iterators.
 
-      function Size (L : Instance) return Natural;
+      function Size (L : Doubly_Linked_List) return Natural;
       --  Obtain the number of elements in list L
 
       -------------------------
@@ -179,11 +187,13 @@ package GNAT.Lists is
       --  iterator has been exhausted, restore all mutation functionality of
       --  the associated list.
 
-      function Iterate (L : Instance) return Iterator;
+      function Iterate (L : Doubly_Linked_List) 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);
+      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
       --  and further attempts are made to advance it, this routine restores
@@ -204,7 +214,7 @@ package GNAT.Lists is
 
       --  The following type represents a list
 
-      type Linked_List is record
+      type Doubly_Linked_List_Attributes is record
          Elements : Natural := 0;
          --  The number of elements in the list
 
@@ -215,8 +225,8 @@ package GNAT.Lists is
          --  The dummy head of the list
       end record;
 
-      type Instance is access all Linked_List;
-      Nil : constant Instance := null;
+      type Doubly_Linked_List is access all Doubly_Linked_List_Attributes;
+      Nil : constant Doubly_Linked_List := null;
 
       --  The following type represents an element iterator
 
@@ -226,9 +236,9 @@ package GNAT.Lists is
          --  iterator requires that this field always points to a valid node. A
          --  value of null indicates that the iterator is exhausted.
 
-         List : Instance := null;
+         List : Doubly_Linked_List := null;
          --  Reference to the associated list
       end record;
-   end Doubly_Linked_List;
+   end Doubly_Linked_Lists;
 
 end GNAT.Lists;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index edc2bd6ac6ff002c6a54fadfd044bca628c11817..782dd4bb720ec81a62308487f1c4047f3f3ba185 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * gnat.dg/linkedlist.adb: Update.
+
 2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * gnat.dg/dynhash.adb, gnat.dg/dynhash1.adb: Update.

diff --git a/gcc/testsuite/gnat.dg/linkedlist.adb b/gcc/testsuite/gnat.dg/linkedlist.adb
index b608fe183f18dfa6c949dd9b4968cd8dc675f0f2..34df2ed7e43dbcdefc4892a5f96965afbc3bff24 100644 (file)
--- a/gcc/testsuite/gnat.dg/linkedlist.adb
+++ b/gcc/testsuite/gnat.dg/linkedlist.adb
@@ -5,35 +5,42 @@ with GNAT;        use GNAT;
 with GNAT.Lists;  use GNAT.Lists;
 
 procedure Linkedlist is
-   package Integer_Lists is new Doubly_Linked_List
-     (Element_Type => Integer,
-      "="          => "=");
+   procedure Destroy (Val : in out Integer) is null;
+
+   package Integer_Lists is new Doubly_Linked_Lists
+     (Element_Type    => Integer,
+      "="             => "=",
+      Destroy_Element => Destroy);
    use Integer_Lists;
 
    procedure Check_Empty
      (Caller    : String;
-      L         : Instance;
+      L         : Doubly_Linked_List;
       Low_Elem  : Integer;
       High_Elem : Integer);
    --  Ensure that none of the elements in the range Low_Elem .. High_Elem are
    --  present in list L, and that the list's length is 0.
 
-   procedure Check_Locked_Mutations (Caller : String; L : in out Instance);
+   procedure Check_Locked_Mutations
+     (Caller : String;
+      L      : in out Doubly_Linked_List);
    --  Ensure that all mutation operations of list L are locked
 
    procedure Check_Present
      (Caller    : String;
-      L         : Instance;
+      L         : Doubly_Linked_List;
       Low_Elem  : Integer;
       High_Elem : Integer);
    --  Ensure that all elements in the range Low_Elem .. High_Elem are present
    --  in list L.
 
-   procedure Check_Unlocked_Mutations (Caller : String; L : in out Instance);
+   procedure Check_Unlocked_Mutations
+     (Caller : String;
+      L      : in out Doubly_Linked_List);
    --  Ensure that all mutation operations of list L are unlocked
 
    procedure Populate_With_Append
-     (L         : Instance;
+     (L         : Doubly_Linked_List;
       Low_Elem  : Integer;
       High_Elem : Integer);
    --  Add elements in the range Low_Elem .. High_Elem in that order in list L
@@ -113,7 +120,7 @@ procedure Linkedlist is
 
    procedure Check_Empty
      (Caller    : String;
-      L         : Instance;
+      L         : Doubly_Linked_List;
       Low_Elem  : Integer;
       High_Elem : Integer)
    is
@@ -137,7 +144,9 @@ procedure Linkedlist is
    -- Check_Locked_Mutations --
    ----------------------------
 
-   procedure Check_Locked_Mutations (Caller : String; L : in out Instance) is
+   procedure Check_Locked_Mutations
+     (Caller : String;
+      L      : in out Doubly_Linked_List) is
    begin
       begin
          Append (L, 1);
@@ -247,7 +256,7 @@ procedure Linkedlist is
 
    procedure Check_Present
      (Caller    : String;
-      L         : Instance;
+      L         : Doubly_Linked_List;
       Low_Elem  : Integer;
       High_Elem : Integer)
    is
@@ -287,7 +296,10 @@ procedure Linkedlist is
    -- Check_Unlocked_Mutations --
    ------------------------------
 
-   procedure Check_Unlocked_Mutations (Caller : String; L : in out Instance) is
+   procedure Check_Unlocked_Mutations
+     (Caller : String;
+      L      : in out Doubly_Linked_List)
+   is
    begin
       Append        (L, 1);
       Append        (L, 2);
@@ -306,7 +318,7 @@ procedure Linkedlist is
    --------------------------
 
    procedure Populate_With_Append
-     (L         : Instance;
+     (L         : Doubly_Linked_List;
       Low_Elem  : Integer;
       High_Elem : Integer)
    is
@@ -321,7 +333,7 @@ procedure Linkedlist is
    -----------------
 
    procedure Test_Append is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       Append (L, 1);
@@ -350,7 +362,7 @@ procedure Linkedlist is
       Low_Bogus  : constant Integer := Low_Elem  - 1;
       High_Bogus : constant Integer := High_Elem + 1;
 
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, Low_Elem, High_Elem);
@@ -388,7 +400,7 @@ procedure Linkedlist is
       Count : Natural;
       Flag  : Boolean;
       Iter  : Iterator;
-      L     : Instance;
+      L     : Doubly_Linked_List;
       Val   : Integer;
 
    begin
@@ -548,7 +560,7 @@ procedure Linkedlist is
       High_Elem : Integer)
    is
       Iter : Iterator;
-      L    : Instance := Create;
+      L    : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, Low_Elem, High_Elem);
@@ -635,7 +647,7 @@ procedure Linkedlist is
      (Low_Elem  : Integer;
       High_Elem : Integer)
    is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, Low_Elem, High_Elem);
@@ -684,7 +696,7 @@ procedure Linkedlist is
      (Low_Elem  : Integer;
       High_Elem : Integer)
    is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, Low_Elem, High_Elem);
@@ -731,7 +743,7 @@ procedure Linkedlist is
 
    procedure Test_First is
       Elem : Integer;
-      L    : Instance := Create;
+      L    : Doubly_Linked_List := Create;
 
    begin
       --  Try to obtain the head. This operation should raise List_Empty.
@@ -766,7 +778,7 @@ procedure Linkedlist is
    -----------------------
 
    procedure Test_Insert_After is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       --  Try to insert after a non-inserted element, in an empty list
@@ -805,7 +817,7 @@ procedure Linkedlist is
    ------------------------
 
    procedure Test_Insert_Before is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       --  Try to insert before a non-inserted element, in an empty list
@@ -844,7 +856,7 @@ procedure Linkedlist is
    -------------------
 
    procedure Test_Is_Empty is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       if not Is_Empty (L) then
@@ -874,7 +886,7 @@ procedure Linkedlist is
       Elem   : Integer;
       Iter_1 : Iterator;
       Iter_2 : Iterator;
-      L      : Instance := Create;
+      L      : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, 1, 5);
@@ -935,7 +947,7 @@ procedure Linkedlist is
    procedure Test_Iterate_Empty is
       Elem : Integer;
       Iter : Iterator;
-      L    : Instance := Create;
+      L    : Doubly_Linked_List := Create;
 
    begin
       --  Obtain an iterator. This action must lock all mutation operations of
@@ -978,7 +990,7 @@ procedure Linkedlist is
    is
       Elem : Integer;
       Iter : Iterator;
-      L    : Instance := Create;
+      L    : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, Low_Elem, High_Elem);
@@ -1026,7 +1038,7 @@ procedure Linkedlist is
 
    procedure Test_Last is
       Elem : Integer;
-      L    : Instance := Create;
+      L    : Doubly_Linked_List := Create;
 
    begin
       --  Try to obtain the tail. This operation should raise List_Empty.
@@ -1061,7 +1073,7 @@ procedure Linkedlist is
    ------------------
 
    procedure Test_Prepend is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       Prepend (L, 5);
@@ -1084,7 +1096,7 @@ procedure Linkedlist is
    ------------------
 
    procedure Test_Replace is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
 
    begin
       Populate_With_Append (L, 1, 5);
@@ -1111,7 +1123,7 @@ procedure Linkedlist is
    ---------------
 
    procedure Test_Size is
-      L : Instance := Create;
+      L : Doubly_Linked_List := Create;
       S : Natural;
 
    begin