Commit 02fd808c by Hristian Kirtchev Committed by Pierre-Marie de Rodat

[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
parent 7f070fc4
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
Instance in various routines.
* libgnat/g-dynhta.ads: Change type Instance to
......
......@@ -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;
......@@ -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;
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.
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment