diff options
| author | Hristian Kirtchev <kirtchev@adacore.com> | 2019-07-01 13:35:01 +0000 |
|---|---|---|
| committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-01 13:35:01 +0000 |
| commit | 02fd808ca20ce82ad63e5a760b5835b87342ba6f (patch) | |
| tree | 779c5e5ac22336999966f2afb9ea370da11b9fe7 /gcc | |
| parent | 7f070fc469c71b0d3e435cf23964b6de7cd9943e (diff) | |
| download | gcc-02fd808ca20ce82ad63e5a760b5835b87342ba6f.zip gcc-02fd808ca20ce82ad63e5a760b5835b87342ba6f.tar.gz gcc-02fd808ca20ce82ad63e5a760b5835b87342ba6f.tar.bz2 | |
[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
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ada/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/ada/libgnat/g-lists.adb | 103 | ||||
| -rw-r--r-- | gcc/ada/libgnat/g-lists.ads | 64 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gnat.dg/linkedlist.adb | 72 |
5 files changed, 156 insertions, 95 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c527b80..570a04a 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,13 @@ 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 diff --git a/gcc/ada/libgnat/g-lists.adb b/gcc/ada/libgnat/g-lists.adb index d1a8616..f7447a5 100644 --- 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 911b85f..b64ef08 100644 --- 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 edc2bd6..782dd4b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,9 @@ 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> diff --git a/gcc/testsuite/gnat.dg/linkedlist.adb b/gcc/testsuite/gnat.dg/linkedlist.adb index b608fe1..34df2ed 100644 --- 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 |