[Ada] General purpose doubly linked list for compiler and tool use

This patch adds unit GNAT.Lists which currently contains the
implementation of a general purpose doubly linked list intended for use
by the compiler and the tools around it.

2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* impunit.adb: Add g-lists to the set of non-implementation
	units.
	* libgnat/g-lists.adb, libgnat/g-lists.ads: New unit.
	* Makefile.rtl: Add g-lists to the set of non-tasking units.
	* gcc-interface/Make-lang.in: Add g-lists to the set of files
	used by gnat1.

gcc/testsuite/

	* gnat.dg/linkedlist.adb: New testcase.

From-SVN: r263714

gcc/ada/ChangeLog

+2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* impunit.adb: Add g-lists to the set of non-implementation
+	units.
+	* libgnat/g-lists.adb, libgnat/g-lists.ads: New unit.
+	* Makefile.rtl: Add g-lists to the set of non-tasking units.
+	* gcc-interface/Make-lang.in: Add g-lists to the set of files
+	used by gnat1.
+
 2018-08-21  Ed Schonberg  <schonberg@adacore.com>
 
 	* exp_ch9.adb (Reset_Scopes): Do not recurse into type

gcc/ada/Makefile.rtl

@@ -427,6 +427,7 @@ GNATRTL_NONTASKING_OBJS= \
   g-htable$(objext) \
   g-io$(objext) \
   g-io_aux$(objext) \
+  g-lists$(objext) \
   g-locfil$(objext) \
   g-mbdira$(objext) \
   g-mbflra$(objext) \

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

@@ -319,6 +319,7 @@ GNAT_ADA_OBJS =	\
  ada/libgnat/g-dynhta.o	\
  ada/libgnat/g-hesora.o	\
  ada/libgnat/g-htable.o	\
+ ada/libgnat/g-lists.o \
  ada/libgnat/g-spchge.o	\
  ada/libgnat/g-speche.o	\
  ada/libgnat/g-u3spch.o	\

gcc/ada/impunit.adb

@@ -281,6 +281,7 @@ package body Impunit is
     ("g-htable", F),  -- GNAT.Htable
     ("g-io    ", F),  -- GNAT.IO
     ("g-io_aux", F),  -- GNAT.IO_Aux
+    ("g-lists ", F),  -- GNAT.Lists
     ("g-locfil", F),  -- GNAT.Lock_Files
     ("g-mbdira", F),  -- GNAT.MBBS_Discrete_Random
     ("g-mbflra", F),  -- GNAT.MBBS_Float_Random

gcc/ada/libgnat/g-lists.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                            G N A T . L I S T S                           --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--             Copyright (C) 2018, Free Software Foundation, Inc.           --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Unchecked_Deallocation;
+
+package body GNAT.Lists is
+
+   package body Doubly_Linked_List is
+      procedure Delete_Node (L : Instance; Nod : Node_Ptr);
+      pragma Inline (Delete_Node);
+      --  Detach and delete node Nod from list L
+
+      procedure Ensure_Circular (Head : Node_Ptr);
+      pragma Inline (Ensure_Circular);
+      --  Ensure that dummy head Head is circular with respect to itself
+
+      procedure Ensure_Created (L : Instance);
+      pragma Inline (Ensure_Created);
+      --  Verify that list L is created. Raise Not_Created if this is not the
+      --  case.
+
+      procedure Ensure_Full (L : Instance);
+      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);
+      pragma Inline (Ensure_Unlocked);
+      --  Verify that list L is unlocked. Raise List_Locked if this is not the
+      --  case.
+
+      function Find_Node
+        (Head : Node_Ptr;
+         Elem : Element_Type) return Node_Ptr;
+      pragma Inline (Find_Node);
+      --  Travers a list indicated by dummy head Head to determine whethe there
+      --  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 (Node, Node_Ptr);
+
+      procedure Insert_Between
+        (L     : Instance;
+         Elem  : Element_Type;
+         Left  : Node_Ptr;
+         Right : Node_Ptr);
+      pragma Inline (Insert_Between);
+      --  Insert element Elem between nodes Left and Right of list L
+
+      function Is_Valid (Iter : Iterator) return Boolean;
+      pragma Inline (Is_Valid);
+      --  Determine whether iterator Iter refers to a valid element
+
+      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);
+      pragma Inline (Lock);
+      --  Lock all mutation functionality of list L
+
+      procedure Unlock (L : Instance);
+      pragma Inline (Unlock);
+      --  Unlock all mutation functionality of list L
+
+      ------------
+      -- Append --
+      ------------
+
+      procedure Append (L : Instance; Elem : Element_Type) is
+         Head : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Unlocked (L);
+
+         --  Ensure that the dummy head of an empty list is circular with
+         --  respect to itself.
+
+         Head := L.Nodes'Access;
+         Ensure_Circular (Head);
+
+         --  Append the node by inserting it between the last node and the
+         --  dummy head.
+
+         Insert_Between
+           (L     => L,
+            Elem  => Elem,
+            Left  => Head.Prev,
+            Right => Head);
+      end Append;
+
+      ------------
+      -- Create --
+      ------------
+
+      function Create return Instance is
+      begin
+         return new Linked_List;
+      end Create;
+
+      --------------
+      -- Contains --
+      --------------
+
+      function Contains (L : Instance; Elem : Element_Type) return Boolean is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Find_Node (Head, Elem);
+
+         return Is_Valid (Nod, Head);
+      end Contains;
+
+      ------------
+      -- Delete --
+      ------------
+
+      procedure Delete (L : Instance; Elem : Element_Type) is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Full     (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Find_Node (Head, Elem);
+
+         if Is_Valid (Nod, Head) then
+            Delete_Node (L, Nod);
+         end if;
+      end Delete;
+
+      ------------------
+      -- Delete_First --
+      ------------------
+
+      procedure Delete_First (L : Instance) is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Full     (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Head.Next;
+
+         if Is_Valid (Nod, Head) then
+            Delete_Node (L, Nod);
+         end if;
+      end Delete_First;
+
+      -----------------
+      -- Delete_Last --
+      -----------------
+
+      procedure Delete_Last (L : Instance) is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Full     (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Head.Prev;
+
+         if Is_Valid (Nod, Head) then
+            Delete_Node (L, Nod);
+         end if;
+      end Delete_Last;
+
+      -----------------
+      -- Delete_Node --
+      -----------------
+
+      procedure Delete_Node (L : Instance; Nod : Node_Ptr) is
+         Ref : Node_Ptr := Nod;
+
+         pragma Assert (Ref /= null);
+
+         Next : constant Node_Ptr := Ref.Next;
+         Prev : constant Node_Ptr := Ref.Prev;
+
+      begin
+         pragma Assert (L    /= null);
+         pragma Assert (Next /= null);
+         pragma Assert (Prev /= null);
+
+         Prev.Next := Next;  --  Prev ---> Next
+         Next.Prev := Prev;  --  Prev <--> Next
+
+         Ref.Next := null;
+         Ref.Prev := null;
+
+         L.Elements := L.Elements - 1;
+
+         Free (Ref);
+      end Delete_Node;
+
+      -------------
+      -- Destroy --
+      -------------
+
+      procedure Destroy (L : in out Instance) is
+         Head : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+
+         while Is_Valid (Head.Next, Head) loop
+            Delete_Node (L, Head.Next);
+         end loop;
+
+         Free (L);
+      end Destroy;
+
+      ---------------------
+      -- Ensure_Circular --
+      ---------------------
+
+      procedure Ensure_Circular (Head : Node_Ptr) is
+         pragma Assert (Head /= null);
+
+      begin
+         if Head.Next = null and then Head.Prev = null then
+            Head.Next := Head;
+            Head.Prev := Head;
+         end if;
+      end Ensure_Circular;
+
+      --------------------
+      -- Ensure_Created --
+      --------------------
+
+      procedure Ensure_Created (L : Instance) is
+      begin
+         if L = null then
+            raise Not_Created;
+         end if;
+      end Ensure_Created;
+
+      -----------------
+      -- Ensure_Full --
+      -----------------
+
+      procedure Ensure_Full (L : Instance) is
+      begin
+         pragma Assert (L /= null);
+
+         if L.Elements = 0 then
+            raise List_Empty;
+         end if;
+      end Ensure_Full;
+
+      ---------------------
+      -- Ensure_Unlocked --
+      ---------------------
+
+      procedure Ensure_Unlocked (L : Instance) is
+      begin
+         pragma Assert (L /= null);
+
+         --  The list has at least one outstanding iterator
+
+         if L.Locked > 0 then
+            raise List_Locked;
+         end if;
+      end Ensure_Unlocked;
+
+      ---------------
+      -- Find_Node --
+      ---------------
+
+      function Find_Node
+        (Head : Node_Ptr;
+         Elem : Element_Type) return Node_Ptr
+      is
+         pragma Assert (Head /= null);
+
+         Nod : Node_Ptr;
+
+      begin
+         --  Traverse the nodes of the list, looking for a matching element
+
+         Nod := Head.Next;
+         while Is_Valid (Nod, Head) loop
+            if Nod.Elem = Elem then
+               return Nod;
+            end if;
+
+            Nod := Nod.Next;
+         end loop;
+
+         return null;
+      end Find_Node;
+
+      -----------
+      -- First --
+      -----------
+
+      function First (L : Instance) return Element_Type is
+      begin
+         Ensure_Created (L);
+         Ensure_Full    (L);
+
+         return L.Nodes.Next.Elem;
+      end First;
+
+      --------------
+      -- Has_Next --
+      --------------
+
+      function Has_Next (Iter : Iterator) return Boolean is
+         Is_OK : constant Boolean := Is_Valid (Iter);
+
+      begin
+         --  The iterator is no longer valid which indicates that it has been
+         --  exhausted. Unlock all mutation functionality of the list because
+         --  the iterator cannot be advanced any further.
+
+         if not Is_OK then
+            Unlock (Iter.List);
+         end if;
+
+         return Is_OK;
+      end Has_Next;
+
+      ------------------
+      -- Insert_After --
+      ------------------
+
+      procedure Insert_After
+        (L     : Instance;
+         After : Element_Type;
+         Elem  : Element_Type)
+      is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Find_Node (Head, After);
+
+         if Is_Valid (Nod, Head) then
+            Insert_Between
+              (L     => L,
+               Elem  => Elem,
+               Left  => Nod,
+               Right => Nod.Next);
+         end if;
+      end Insert_After;
+
+      -------------------
+      -- Insert_Before --
+      -------------------
+
+      procedure Insert_Before
+        (L      : Instance;
+         Before : Element_Type;
+         Elem   : Element_Type)
+      is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Find_Node (Head, Before);
+
+         if Is_Valid (Nod, Head) then
+            Insert_Between
+              (L     => L,
+               Elem  => Elem,
+               Left  => Nod.Prev,
+               Right => Nod);
+         end if;
+      end Insert_Before;
+
+      --------------------
+      -- Insert_Between --
+      --------------------
+
+      procedure Insert_Between
+        (L     : Instance;
+         Elem  : Element_Type;
+         Left  : Node_Ptr;
+         Right : Node_Ptr)
+      is
+         pragma Assert (L     /= null);
+         pragma Assert (Left  /= null);
+         pragma Assert (Right /= null);
+
+         Nod : constant Node_Ptr :=
+                 new Node'(Elem => Elem,
+                           Next => Right,  --  Left      Nod ---> Right
+                           Prev => Left);  --  Left <--- Nod ---> Right
+
+      begin
+         Left.Next  := Nod;                --  Left <--> Nod ---> Right
+         Right.Prev := Nod;                --  Left <--> Nod <--> Right
+
+         L.Elements := L.Elements + 1;
+      end Insert_Between;
+
+      --------------
+      -- Is_Empty --
+      --------------
+
+      function Is_Empty (L : Instance) return Boolean is
+      begin
+         Ensure_Created (L);
+
+         return L.Elements = 0;
+      end Is_Empty;
+
+      --------------
+      -- Is_Valid --
+      --------------
+
+      function Is_Valid (Iter : Iterator) return Boolean is
+      begin
+         --  The invariant of Iterate and Next ensures that the iterator always
+         --  refers to a valid node if there exists one.
+
+         return Is_Valid (Iter.Nod, Iter.List.Nodes'Access);
+      end Is_Valid;
+
+      --------------
+      -- Is_Valid --
+      --------------
+
+      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.
+
+         return Nod /= null and then Nod /= Head;
+      end Is_Valid;
+
+      -------------
+      -- Iterate --
+      -------------
+
+      function Iterate (L : Instance) return Iterator is
+      begin
+         Ensure_Created (L);
+
+         --  Lock all mutation functionality of the list while it is being
+         --  iterated on.
+
+         Lock (L);
+
+         return (List => L, Nod => L.Nodes.Next);
+      end Iterate;
+
+      ----------
+      -- Last --
+      ----------
+
+      function Last (L : Instance) return Element_Type is
+      begin
+         Ensure_Created (L);
+         Ensure_Full   (L);
+
+         return L.Nodes.Prev.Elem;
+      end Last;
+
+      ------------
+      -- Length --
+      ------------
+
+      function Length (L : Instance) return Element_Count_Type is
+      begin
+         Ensure_Created (L);
+
+         return L.Elements;
+      end Length;
+
+      ----------
+      -- Lock --
+      ----------
+
+      procedure Lock (L : Instance) is
+      begin
+         pragma Assert (L /= null);
+
+         --  The list may be locked multiple times if multiple iterators are
+         --  operating over it.
+
+         L.Locked := L.Locked + 1;
+      end Lock;
+
+      ----------
+      -- Next --
+      ----------
+
+      procedure Next
+        (Iter : in out Iterator;
+         Elem : out Element_Type)
+      is
+         Is_OK : constant Boolean  := Is_Valid (Iter);
+         Saved : constant Node_Ptr := Iter.Nod;
+
+      begin
+         --  The iterator is no linger valid which indicates that it has been
+         --  exhausted. Unlock all mutation functionality of the list as the
+         --  iterator cannot be advanced any further.
+
+         if not Is_OK then
+            Unlock (Iter.List);
+            raise Iterator_Exhausted;
+         end if;
+
+         --  Advance to the next node along the list
+
+         Iter.Nod := Iter.Nod.Next;
+         Elem     := Saved.Elem;
+      end Next;
+
+      -------------
+      -- Prepend --
+      -------------
+
+      procedure Prepend (L : Instance; Elem : Element_Type) is
+         Head : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Unlocked (L);
+
+         --  Ensure that the dummy head of an empty list is circular with
+         --  respect to itself.
+
+         Head := L.Nodes'Access;
+         Ensure_Circular (Head);
+
+         --  Append the node by inserting it between the dummy head and the
+         --  first node.
+
+         Insert_Between
+           (L     => L,
+            Elem  => Elem,
+            Left  => Head,
+            Right => Head.Next);
+      end Prepend;
+
+      -------------
+      -- Replace --
+      -------------
+
+      procedure Replace
+        (L        : Instance;
+         Old_Elem : Element_Type;
+         New_Elem : Element_Type)
+      is
+         Head : Node_Ptr;
+         Nod  : Node_Ptr;
+
+      begin
+         Ensure_Created  (L);
+         Ensure_Unlocked (L);
+
+         Head := L.Nodes'Access;
+         Nod  := Find_Node (Head, Old_Elem);
+
+         if Is_Valid (Nod, Head) then
+            Nod.Elem := New_Elem;
+         end if;
+      end Replace;
+
+      ------------
+      -- Unlock --
+      ------------
+
+      procedure Unlock (L : Instance) is
+      begin
+         pragma Assert (L /= null);
+
+         --  The list may be locked multiple times if multiple iterators are
+         --  operating over it.
+
+         L.Locked := L.Locked - 1;
+      end Unlock;
+   end Doubly_Linked_List;
+
+end GNAT.Lists;

gcc/ada/libgnat/g-lists.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                            G N A T . L I S T S                           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--             Copyright (C) 2018, Free Software Foundation, Inc.           --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+pragma Compiler_Unit_Warning;
+
+package GNAT.Lists is
+
+   ------------------------
+   -- Doubly_Linked_List --
+   ------------------------
+
+   --  The following package offers a doubly linked list abstraction with the
+   --  following characteristics:
+   --
+   --    * Creation of multiple instances, of different sizes.
+   --    * Iterable elements.
+   --
+   --  The following use pattern must be employed with this list:
+   --
+   --    List : Instance := Create;
+   --
+   --    <various operations>
+   --
+   --    Destroy (List)
+   --
+   --  The destruction of the list reclaims all storage occupied by it.
+
+   --  The following type denotes the number of elements stored in a list
+
+   type Element_Count_Type is range 0 .. 2 ** 31 - 1;
+
+   generic
+      type Element_Type is private;
+
+      with function "="
+        (Left  : Element_Type;
+         Right : Element_Type) return Boolean;
+
+   package Doubly_Linked_List is
+
+      ---------------------
+      -- List operations --
+      ---------------------
+
+      type Instance is private;
+      Nil : constant Instance;
+
+      List_Empty : exception;
+      --  This exception is raised when the list is empty, and an attempt is
+      --  made to delete an element from it.
+
+      List_Locked : exception;
+      --  This exception is raised when the list is being iterated on, and an
+      --  attempt is made to mutate its state.
+
+      Not_Created : exception;
+      --  This exception is raised when the list has not been created by
+      --  routine Create, and an attempt is made to read or mutate its state.
+
+      procedure Append (L : Instance; Elem : Element_Type);
+      --  Insert element Elem at the end of list L. This action will raise
+      --  List_Locked if the list has outstanding iterators.
+
+      function Contains (L : Instance; Elem : Element_Type) return Boolean;
+      --  Determine whether list L contains element Elem
+
+      function Create return Instance;
+      --  Create a new list
+
+      procedure Delete (L : Instance; 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.
+      --    * List_Locked if the list has outstanding iterators.
+
+      procedure Delete_First (L : Instance);
+      --  Delete an element from the start of list L. This action will raise
+      --
+      --    * List_Empty if the list is empty.
+      --    * List_Locked if the list has outstanding iterators.
+
+      procedure Delete_Last (L : Instance);
+      --  Delete an element from the end of list L. This action will raise
+      --
+      --    * List_Empty if the list is empty.
+      --    * List_Locked if the list has outstanding iterators.
+
+      procedure Destroy (L : in out Instance);
+      --  Destroy the contents of list L. This routine must be called at the
+      --  end of a list's lifetime. This action will raise List_Locked if the
+      --  list has outstanding iterators.
+
+      function First (L : Instance) 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;
+         After : Element_Type;
+         Elem  : Element_Type);
+      --  Insert new element Elem after element After in list L. The routine
+      --  has no effect if After is not present. This action will raise
+      --  List_Locked if the list has outstanding iterators.
+
+      procedure Insert_Before
+        (L      : Instance;
+         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
+      --  List_Locked if the list has outstanding iterators.
+
+      function Is_Empty (L : Instance) return Boolean;
+      --  Determine whether list L is empty
+
+      function Last (L : Instance) return Element_Type;
+      --  Obtain an element from the end of list L. This action will raise
+      --  List_Empty if the list is empty.
+
+      function Length (L : Instance) return Element_Count_Type;
+      --  Obtain the number of elements in list L
+
+      procedure Prepend (L : Instance; Elem : Element_Type);
+      --  Insert element Elem at the start of list L. This action will raise
+      --  List_Locked if the list has outstanding iterators.
+
+      procedure Replace
+        (L        : Instance;
+         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 List_Locked if the list has outstanding iterators.
+
+      -------------------------
+      -- Iterator operations --
+      -------------------------
+
+      --  The following type represents an element iterator. An iterator locks
+      --  all mutation operations, and ulocks them once it is exhausted. The
+      --  iterator must be used with the following pattern:
+      --
+      --    Iter := Iterate (My_List);
+      --    while Has_Next (Iter) loop
+      --       Next (Iter, Element);
+      --    end loop;
+      --
+      --  It is possible to advance the iterator by using Next only, however
+      --  this risks raising Iterator_Exhausted.
+
+      type Iterator is private;
+
+      Iterator_Exhausted : exception;
+      --  This exception is raised when an iterator is exhausted and further
+      --  attempts to advance it are made by calling routine Next.
+
+      function Iterate (L : Instance) return Iterator;
+      --  Obtain an iterator over the elements of list L. This action locks all
+      --  mutation functionality of the associated list.
+
+      function Has_Next (Iter : Iterator) return Boolean;
+      --  Determine whether iterator Iter has more elements to examine. If the
+      --  iterator has been exhausted, restore all mutation functionality of
+      --  the associated list.
+
+      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
+      --  mutation functionality of the associated list, and then raises
+      --  Iterator_Exhausted.
+
+   private
+      --  The following type represents a list node
+
+      type Node;
+      type Node_Ptr is access all Node;
+      type Node is record
+         Elem : Element_Type;
+
+         Next : Node_Ptr := null;
+         Prev : Node_Ptr := null;
+      end record;
+
+      --  The following type represents a list
+
+      type Linked_List is record
+         Elements : Element_Count_Type := 0;
+         --  The number of elements in the list
+
+         Locked : Natural := 0;
+         --  Number of outstanding iterators
+
+         Nodes : aliased Node;
+         --  The dummy head of the list
+      end record;
+
+      type Instance is access all Linked_List;
+      Nil : constant Instance := null;
+
+      --  The following type represents an element iterator
+
+      type Iterator is record
+         List : Instance := null;
+         --  Reference to the associated list
+
+         Nod : Node_Ptr := null;
+         --  Reference to the current node being examined. The invariant of the
+         --  iterator requires that this field always points to a valid node. A
+         --  value of null indicates that the iterator is exhausted.
+      end record;
+   end Doubly_Linked_List;
+
+end GNAT.Lists;

gcc/testsuite/ChangeLog

 2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* gnat.dg/linkedlist.adb: New testcase.
+
+2018-08-21  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* gnat.dg/elab6.adb, gnat.dg/elab6.ads, gnat.dg/elab6_pkg.adb,
 	gnat.dg/elab6_pkg.ads: New testcase.
 

gcc/testsuite/gnat.dg/linkedlist.adb

+--  { dg-do run }
+
+with Ada.Text_IO; use Ada.Text_IO;
+with GNAT.Lists;  use GNAT.Lists;
+
+procedure Linkedlist is
+   package Integer_Lists is new Doubly_Linked_List
+     (Element_Type => Integer,
+      "="          => "=");
+   use Integer_Lists;
+
+   procedure Check_Empty
+     (Caller    : String;
+      L         : Instance;
+      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);
+   --  Ensure that all mutation operations of list L are locked
+
+   procedure Check_Present
+     (Caller    : String;
+      L         : Instance;
+      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);
+   --  Ensure that all mutation operations of list L are unlocked
+
+   procedure Populate_With_Append
+     (L         : Instance;
+      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_Length;
+   --  Verify that Length returns the correct length 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
+
+   -----------------
+   -- Check_Empty --
+   -----------------
+
+   procedure Check_Empty
+     (Caller    : String;
+      L         : Instance;
+      Low_Elem  : Integer;
+      High_Elem : Integer)
+   is
+      Len : constant Element_Count_Type := Length (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 Instance) is
+   begin
+      begin
+         Append (L, 1);
+         Put_Line ("ERROR: " & Caller & ": Append: no exception raised");
+      exception
+         when List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            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 List_Locked =>
+            null;
+         when others =>
+            Put_Line ("ERROR: " & Caller & ": Replace: unexpected exception");
+      end;
+   end Check_Locked_Mutations;
+
+   -------------------
+   -- Check_Present --
+   -------------------
+
+   procedure Check_Present
+     (Caller    : String;
+      L         : Instance;
+      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 Instance) 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         : Instance;
+      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 : Instance := 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 : Instance := 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 : Element_Count_Type;
+      Flag  : Boolean;
+      Iter  : Iterator;
+      L     : Instance;
+      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
+         Count := Length (L);
+         Put_Line ("ERROR: Test_Create: Length: no exception raised");
+      exception
+         when Not_Created =>
+            null;
+         when others =>
+            Put_Line ("ERROR: Test_Create: Length: 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;
+   end Test_Create;
+
+   -----------------
+   -- Test_Delete --
+   -----------------
+
+   procedure Test_Delete
+     (Low_Elem  : Integer;
+      High_Elem : Integer)
+   is
+      Iter : Iterator;
+      L    : Instance := 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 : Instance := 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 : Instance := 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    : Instance := 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 : Instance := 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 : Instance := 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 : Instance := 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      : Instance := 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    : Instance := 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    : Instance := 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    : Instance := 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_Length --
+   -----------------
+
+   procedure Test_Length is
+      L   : Instance := Create;
+      Len : Element_Count_Type;
+
+   begin
+      Len := Length (L);
+
+      if Len /= 0 then
+         Put_Line ("ERROR: Test_Length: wrong length");
+         Put_Line ("expected: 0");
+         Put_Line ("got     :" & Len'Img);
+      end if;
+
+      Populate_With_Append (L, 1, 2);
+      Len := Length (L);
+
+      if Len /= 2 then
+         Put_Line ("ERROR: Test_Length: wrong length");
+         Put_Line ("expected: 2");
+         Put_Line ("got     :" & Len'Img);
+      end if;
+
+      Populate_With_Append (L, 3, 6);
+      Len := Length (L);
+
+      if Len /= 6 then
+         Put_Line ("ERROR: Test_Length: wrong length");
+         Put_Line ("expected: 6");
+         Put_Line ("got     :" & Len'Img);
+      end if;
+
+      Destroy (L);
+   end Test_Length;
+
+   ------------------
+   -- Test_Prepend --
+   ------------------
+
+   procedure Test_Prepend is
+      L : Instance := 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 : Instance := 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;
+
+--  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_Length;
+   Test_Prepend;
+   Test_Replace;
+end Linkedlist;