| -- { dg-do run } |
| |
| with Ada.Text_IO; use Ada.Text_IO; |
| with GNAT; use GNAT; |
| with GNAT.Lists; use GNAT.Lists; |
| |
| procedure Linkedlist 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_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 |
| Append (L, 1); |
| Append (L, 2); |
| Append (L, 3); |
| Delete (L, 1); |
| Delete_First (L); |
| Delete_Last (L); |
| Insert_After (L, 2, 3); |
| Insert_Before (L, 2, 1); |
| Prepend (L, 0); |
| Replace (L, 3, 4); |
| 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 |
| Iter : Iterator; |
| 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_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_Replace; |
| Test_Size; |
| end Linkedlist; |
