[Ada] New unit GNAT.Sets

This patch implements unit GNAT.Sets which currently offers a general purpose
membership set. The patch also streamlines GNAT.Dynamic_HTables and GNAT.Lists
to use parts of the same API, types, and exceptions as those used by GNAT.Sets.

2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* gcc-interface/Make-lang.in: Add unit GNAT.Sets to the list of
	front end sources.
	* impunit.adb: Add unit GNAT.Sets to the list of predefined
	units.
	* Makefile.rtl: Add unit GNAT.Sets to the list of non-tasking
	units.
	* libgnat/g-sets.adb: New unit.
	* libgnat/g-sets.ads: New unit.
	* libgnat/g-dynhta.adb (Minimum_Size): Decrease to 8 in order to
	allow for small sets.  Update all occurrences of Table_Locked to
	Iterated.
	(Ensure_Unlocked): Query the number of iterators.
	(Find_Node): Use the supplied equality.
	(Is_Empty): New routine.
	(Lock): Update the number of iterators.
	(Prepend_Or_Replace): Use the supplied equality.
	(Size): Update the return type.
	(Unlock): Update the number of iterators.
	* libgnat/g-dynhta.ads: Update all occurrences of Table_Locked
	to Iterated.  Rename formal subprogram Equivalent_Keys to "=".
	(Bucket_Range_Type, Pair_Count_Type): Remove types.
	(Not_Created, Table_Locked, Iterator_Exhausted): Remove
	exceptions.
	(Hash_Table): Update to store the number of iterators rather
	than locks.
	(Is_Empty): New routine.
	(Size): Update the return type.
	* libgnat/g-lists.adb: Update all occurrences of List_Locked to
	Iterated.
	(Ensure_Unlocked): Query the number of iterators.
	(Length): Remove.
	(Lock): Update the number of iterators.
	(Size): New routine.
	(Unlock): Update the number of iterators.
	* libgnat/g-lists.ads: Update all occurrences of List_Locked to
	Iterated.
	(Element_Count_Type): Remove type.
	(Not_Created, Table_Locked, Iterator_Exhausted): Remove
	exceptions.
	(Linked_List): Update type to store the number of iterators
	rather than locks.
	(Length): Remove.
	(Size): New routine.
	* libgnat/gnat.ads (Bucket_Range_Type): New type.
	(Iterated, Iterator_Exhausted, and Not_Created): New exceptions.

gcc/testsuite/

	* gnat.dg/sets1.adb: New testcase.
	* gnat.dg/dynhash.adb, gnat.dg/linkedlist.adb: Update testcases
	to new API.

From-SVN: r264620

gcc/ada/ChangeLog

+2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gcc-interface/Make-lang.in: Add unit GNAT.Sets to the list of
+	front end sources.
+	* impunit.adb: Add unit GNAT.Sets to the list of predefined
+	units.
+	* Makefile.rtl: Add unit GNAT.Sets to the list of non-tasking
+	units.
+	* libgnat/g-sets.adb: New unit.
+	* libgnat/g-sets.ads: New unit.
+	* libgnat/g-dynhta.adb (Minimum_Size): Decrease to 8 in order to
+	allow for small sets.  Update all occurrences of Table_Locked to
+	Iterated.
+	(Ensure_Unlocked): Query the number of iterators.
+	(Find_Node): Use the supplied equality.
+	(Is_Empty): New routine.
+	(Lock): Update the number of iterators.
+	(Prepend_Or_Replace): Use the supplied equality.
+	(Size): Update the return type.
+	(Unlock): Update the number of iterators.
+	* libgnat/g-dynhta.ads: Update all occurrences of Table_Locked
+	to Iterated.  Rename formal subprogram Equivalent_Keys to "=".
+	(Bucket_Range_Type, Pair_Count_Type): Remove types.
+	(Not_Created, Table_Locked, Iterator_Exhausted): Remove
+	exceptions.
+	(Hash_Table): Update to store the number of iterators rather
+	than locks.
+	(Is_Empty): New routine.
+	(Size): Update the return type.
+	* libgnat/g-lists.adb: Update all occurrences of List_Locked to
+	Iterated.
+	(Ensure_Unlocked): Query the number of iterators.
+	(Length): Remove.
+	(Lock): Update the number of iterators.
+	(Size): New routine.
+	(Unlock): Update the number of iterators.
+	* libgnat/g-lists.ads: Update all occurrences of List_Locked to
+	Iterated.
+	(Element_Count_Type): Remove type.
+	(Not_Created, Table_Locked, Iterator_Exhausted): Remove
+	exceptions.
+	(Linked_List): Update type to store the number of iterators
+	rather than locks.
+	(Length): Remove.
+	(Size): New routine.
+	* libgnat/gnat.ads (Bucket_Range_Type): New type.
+	(Iterated, Iterator_Exhausted, and Not_Created): New exceptions.
+
 2018-09-26  Javier Miranda  <miranda@adacore.com>
 
 	* checks.adb (Install_Null_Excluding_Check): Do not add

gcc/ada/Makefile.rtl

@@ -445,6 +445,7 @@ GNATRTL_NONTASKING_OBJS= \
   g-sehash$(objext) \
   g-sercom$(objext) \
   g-sestin$(objext) \
+  g-sets$(objext) \
   g-sha1$(objext) \
   g-sha224$(objext) \
   g-sha256$(objext) \

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

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

gcc/ada/impunit.adb

@@ -298,6 +298,7 @@ package body Impunit is
     ("g-semaph", F),  -- GNAT.Semaphores
     ("g-sercom", F),  -- GNAT.Serial_Communications
     ("g-sestin", F),  -- GNAT.Secondary_Stack_Info
+    ("g-sets  ", F),  -- GNAT.Sets
     ("g-sha1  ", F),  -- GNAT.SHA1
     ("g-sha224", F),  -- GNAT.SHA224
     ("g-sha256", F),  -- GNAT.SHA256

gcc/ada/libgnat/g-dynhta.adb

@@ -369,7 +369,7 @@ package body GNAT.Dynamic_HTables is
    --------------------
 
    package body Dynamic_HTable is
-      Minimum_Size : constant Bucket_Range_Type := 32;
+      Minimum_Size : constant Bucket_Range_Type := 8;
       --  Minimum size of the buckets
 
       Safe_Compression_Size : constant Bucket_Range_Type :=
@@ -401,8 +401,8 @@ package body GNAT.Dynamic_HTables is
 
       procedure Ensure_Unlocked (T : Instance);
       pragma Inline (Ensure_Unlocked);
-      --  Verify that hash table T is unlocked. Raise Table_Locked if this is
-      --  not the case.
+      --  Verify that hash table T is unlocked. Raise Iterated if this is not
+      --  the case.
 
       function Find_Bucket
         (Bkts : Bucket_Table_Ptr;
@@ -472,9 +472,10 @@ package body GNAT.Dynamic_HTables is
       -- Create --
       ------------
 
-      function Create (Initial_Size : Bucket_Range_Type) return Instance is
+      function Create (Initial_Size : Positive) return Instance is
          Size : constant Bucket_Range_Type :=
-                           Bucket_Range_Type'Max (Initial_Size, Minimum_Size);
+                           Bucket_Range_Type'Max
+                             (Bucket_Range_Type (Initial_Size), Minimum_Size);
          --  Ensure that the buckets meet a minimum size
 
          T : constant Instance := new Hash_Table;
@@ -661,8 +662,8 @@ package body GNAT.Dynamic_HTables is
 
          --  The hash table has at least one outstanding iterator
 
-         if T.Locked > 0 then
-            raise Table_Locked;
+         if T.Iterators > 0 then
+            raise Iterated;
          end if;
       end Ensure_Unlocked;
 
@@ -697,7 +698,7 @@ package body GNAT.Dynamic_HTables is
 
          Nod := Head.Next;
          while Is_Valid (Nod, Head) loop
-            if Equivalent_Keys (Nod.Key, Key) then
+            if Nod.Key = Key then
                return Nod;
             end if;
 
@@ -798,6 +799,17 @@ package body GNAT.Dynamic_HTables is
       end Has_Next;
 
       --------------
+      -- Is_Empty --
+      --------------
+
+      function Is_Empty (T : Instance) return Boolean is
+      begin
+         Ensure_Created (T);
+
+         return T.Pairs = 0;
+      end Is_Empty;
+
+      --------------
       -- Is_Valid --
       --------------
 
@@ -880,7 +892,7 @@ package body GNAT.Dynamic_HTables is
          --  The hash table may be locked multiple times if multiple iterators
          --  are operating over it.
 
-         T.Locked := T.Locked + 1;
+         T.Iterators := T.Iterators + 1;
       end Lock;
 
       -----------------------
@@ -1046,11 +1058,7 @@ package body GNAT.Dynamic_HTables is
       -- Put --
       ---------
 
-      procedure Put
-        (T     : Instance;
-         Key   : Key_Type;
-         Value : Value_Type)
-      is
+      procedure Put (T : Instance; Key : Key_Type; Value : Value_Type) is
          procedure Expand;
          pragma Inline (Expand);
          --  Determine whether hash table T requires expansion, and if so,
@@ -1099,7 +1107,7 @@ package body GNAT.Dynamic_HTables is
 
             Nod := Head.Next;
             while Is_Valid (Nod, Head) loop
-               if Equivalent_Keys (Nod.Key, Key) then
+               if Nod.Key = Key then
                   Nod.Value := Value;
                   return;
                end if;
@@ -1172,7 +1180,7 @@ package body GNAT.Dynamic_HTables is
       -- Size --
       ----------
 
-      function Size (T : Instance) return Pair_Count_Type is
+      function Size (T : Instance) return Natural is
       begin
          Ensure_Created (T);
 
@@ -1188,7 +1196,7 @@ package body GNAT.Dynamic_HTables is
          --  The hash table may be locked multiple times if multiple iterators
          --  are operating over it.
 
-         T.Locked := T.Locked - 1;
+         T.Iterators := T.Iterators - 1;
       end Unlock;
    end Dynamic_HTable;
 

gcc/ada/libgnat/g-dynhta.ads

@@ -283,21 +283,11 @@ package GNAT.Dynamic_HTables is
    --
    --  The destruction of the table reclaims all storage occupied by it.
 
-   --  The following type denotes the underlying range of the hash table
-   --  buckets.
-
-   type Bucket_Range_Type is mod 2 ** 32;
-
    --  The following type denotes the multiplicative factor used in expansion
    --  and compression of the hash table.
 
    subtype Factor_Type is Bucket_Range_Type range 2 .. 100;
 
-   --  The following type denotes the number of key-value pairs stored in the
-   --  hash table.
-
-   type Pair_Count_Type is range 0 .. 2 ** 31 - 1;
-
    --  The following type denotes the threshold range used in expansion and
    --  compression of the hash table.
 
@@ -333,10 +323,9 @@ package GNAT.Dynamic_HTables is
       --  that the size of the buckets will be halved once the load factor
       --  drops below 0.5.
 
-      with function Equivalent_Keys
+      with function "="
              (Left  : Key_Type;
               Right : Key_Type) return Boolean;
-      --  Determine whether two keys are equivalent
 
       with function Hash (Key : Key_Type) return Bucket_Range_Type;
       --  Map an arbitrary key into the range of buckets
@@ -353,52 +342,44 @@ package GNAT.Dynamic_HTables is
       type Instance is private;
       Nil : constant Instance;
 
-      Not_Created : exception;
-      --  This exception is raised when the hash table has not been created by
-      --  routine Create, and an attempt is made to read or mutate its state.
-
-      Table_Locked : exception;
-      --  This exception is raised when the hash table is being iterated on,
-      --  and an attempt is made to mutate its state.
-
-      function Create (Initial_Size : Bucket_Range_Type) return Instance;
+      function Create (Initial_Size : Positive) return Instance;
       --  Create a new table with bucket capacity Initial_Size. This routine
       --  must be called at the start of a hash table's lifetime.
 
       procedure Delete (T : Instance; Key : Key_Type);
       --  Delete the value which corresponds to key Key from hash table T. The
       --  routine has no effect if the value is not present in the hash table.
-      --  This action will raise Table_Locked if the hash table has outstanding
+      --  This action will raise Iterated if the hash table has outstanding
       --  iterators. If the load factor drops below Compression_Threshold, the
       --  size of the buckets is decreased by Copression_Factor.
 
       procedure Destroy (T : in out Instance);
       --  Destroy the contents of hash table T, rendering it unusable. This
       --  routine must be called at the end of a hash table's lifetime. This
-      --  action will raise Table_Locked if the hash table has outstanding
+      --  action will raise Iterated if the hash table has outstanding
       --  iterators.
 
       function Get (T : Instance; Key : Key_Type) return Value_Type;
       --  Obtain the value which corresponds to key Key from hash table T. If
       --  the value does not exist, return No_Value.
 
-      procedure Put
-        (T     : Instance;
-         Key   : Key_Type;
-         Value : Value_Type);
+      function Is_Empty (T : Instance) return Boolean;
+      --  Determine whether hash table T is empty
+
+      procedure Put (T : Instance; Key : Key_Type; Value : Value_Type);
       --  Associate value Value with key Key in hash table T. If the table
       --  already contains a mapping of the same key to a previous value, the
-      --  previous value is overwritten. This action will raise Table_Locked
-      --  if the hash table has outstanding iterators. If the load factor goes
+      --  previous value is overwritten. This action will raise Iterated if
+      --  the hash table has outstanding iterators. If the load factor goes
       --  over Expansion_Threshold, the size of the buckets is increased by
       --  Expansion_Factor.
 
       procedure Reset (T : Instance);
       --  Destroy the contents of hash table T, and reset it to its initial
-      --  created state. This action will raise Table_Locked if the hash table
+      --  created state. This action will raise Iterated if the hash table
       --  has outstanding iterators.
 
-      function Size (T : Instance) return Pair_Count_Type;
+      function Size (T : Instance) return Natural;
       --  Obtain the number of key-value pairs in hash table T
 
       -------------------------
@@ -420,10 +401,6 @@ package GNAT.Dynamic_HTables is
 
       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 (T : Instance) return Iterator;
       --  Obtain an iterator over the keys of hash table T. This action locks
       --  all mutation functionality of the associated hash table.
@@ -433,9 +410,7 @@ package GNAT.Dynamic_HTables is
       --  iterator has been exhausted, restore all mutation functionality of
       --  the associated hash table.
 
-      procedure Next
-        (Iter : in out Iterator;
-         Key  : out Key_Type);
+      procedure Next (Iter : in out Iterator; Key : out Key_Type);
       --  Return the current key referenced by iterator Iter and advance to
       --  the next available key. If the iterator has been exhausted and
       --  further attempts are made to advance it, this routine restores
@@ -487,10 +462,10 @@ package GNAT.Dynamic_HTables is
          Initial_Size : Bucket_Range_Type := 0;
          --  The initial size of the buckets as specified at creation time
 
-         Locked : Natural := 0;
+         Iterators : Natural := 0;
          --  Number of outstanding iterators
 
-         Pairs : Pair_Count_Type := 0;
+         Pairs : Natural := 0;
          --  Number of key-value pairs in the buckets
       end record;
 

gcc/ada/libgnat/g-lists.adb

@@ -54,7 +54,7 @@ package body GNAT.Lists is
 
       procedure Ensure_Unlocked (L : Instance);
       pragma Inline (Ensure_Unlocked);
-      --  Verify that list L is unlocked. Raise List_Locked if this is not the
+      --  Verify that list L is unlocked. Raise Iterated if this is not the
       --  case.
 
       function Find_Node
@@ -306,8 +306,8 @@ package body GNAT.Lists is
 
          --  The list has at least one outstanding iterator
 
-         if L.Locked > 0 then
-            raise List_Locked;
+         if L.Iterators > 0 then
+            raise Iterated;
          end if;
       end Ensure_Unlocked;
 
@@ -514,17 +514,6 @@ package body GNAT.Lists is
          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 --
       ----------
@@ -536,17 +525,14 @@ package body GNAT.Lists is
          --  The list may be locked multiple times if multiple iterators are
          --  operating over it.
 
-         L.Locked := L.Locked + 1;
+         L.Iterators := L.Iterators + 1;
       end Lock;
 
       ----------
       -- 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.Nod;
 
@@ -617,6 +603,17 @@ package body GNAT.Lists is
          end if;
       end Replace;
 
+      ----------
+      -- Size --
+      ----------
+
+      function Size (L : Instance) return Natural is
+      begin
+         Ensure_Created (L);
+
+         return L.Elements;
+      end Size;
+
       ------------
       -- Unlock --
       ------------
@@ -628,7 +625,7 @@ package body GNAT.Lists is
          --  The list may be locked multiple times if multiple iterators are
          --  operating over it.
 
-         L.Locked := L.Locked - 1;
+         L.Iterators := L.Iterators - 1;
       end Unlock;
    end Doubly_Linked_List;
 

gcc/ada/libgnat/g-lists.ads

@@ -49,14 +49,10 @@ package GNAT.Lists is
    --
    --    <various operations>
    --
-   --    Destroy (List)
+   --    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;
 
@@ -73,21 +69,14 @@ package GNAT.Lists is
       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.
+      --  The following 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.
+      List_Empty : exception;
 
       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.
+      --  Iterated if the list has outstanding iterators.
 
       function Contains (L : Instance; Elem : Element_Type) return Boolean;
       --  Determine whether list L contains element Elem
@@ -100,23 +89,23 @@ package GNAT.Lists is
       --  not present. This action will raise
       --
       --    * List_Empty if the list is empty.
-      --    * List_Locked if the list has outstanding iterators.
+      --    * Iterated 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.
+      --    * Iterated 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.
+      --    * Iterated 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
+      --  end of a list's lifetime. This action will raise Iterated if the
       --  list has outstanding iterators.
 
       function First (L : Instance) return Element_Type;
@@ -129,7 +118,7 @@ package GNAT.Lists is
          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.
+      --  Iterated if the list has outstanding iterators.
 
       procedure Insert_Before
         (L      : Instance;
@@ -137,7 +126,7 @@ package GNAT.Lists is
          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.
+      --  Iterated if the list has outstanding iterators.
 
       function Is_Empty (L : Instance) return Boolean;
       --  Determine whether list L is empty
@@ -146,12 +135,9 @@ package GNAT.Lists is
       --  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.
+      --  Iterated if the list has outstanding iterators.
 
       procedure Replace
         (L        : Instance;
@@ -159,7 +145,10 @@ package GNAT.Lists is
          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.
+      --  raise Iterated if the list has outstanding iterators.
+
+      function Size (L : Instance) return Natural;
+      --  Obtain the number of elements in list L
 
       -------------------------
       -- Iterator operations --
@@ -179,10 +168,6 @@ package GNAT.Lists is
 
       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.
@@ -192,9 +177,7 @@ package GNAT.Lists is
       --  iterator has been exhausted, restore 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
@@ -216,10 +199,10 @@ package GNAT.Lists is
       --  The following type represents a list
 
       type Linked_List is record
-         Elements : Element_Count_Type := 0;
+         Elements : Natural := 0;
          --  The number of elements in the list
 
-         Locked : Natural := 0;
+         Iterators : Natural := 0;
          --  Number of outstanding iterators
 
          Nodes : aliased Node;

gcc/ada/libgnat/g-sets.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                            G N A T . S E T S                             --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--                        Copyright (C) 2018, AdaCore                       --
+--                                                                          --
+-- 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.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+package body GNAT.Sets is
+
+   --------------------
+   -- Membership_Set --
+   --------------------
+
+   package body Membership_Set is
+
+      --------------
+      -- Contains --
+      --------------
+
+      function Contains (S : Instance; Elem : Element_Type) return Boolean is
+      begin
+         return Hashed_Set.Get (Hashed_Set.Instance (S), Elem);
+      end Contains;
+
+      ------------
+      -- Create --
+      ------------
+
+      function Create (Initial_Size : Positive) return Instance is
+      begin
+         return Instance (Hashed_Set.Create (Initial_Size));
+      end Create;
+
+      ------------
+      -- Delete --
+      ------------
+
+      procedure Delete (S : Instance; Elem : Element_Type) is
+      begin
+         Hashed_Set.Delete (Hashed_Set.Instance (S), Elem);
+      end Delete;
+
+      -------------
+      -- Destroy --
+      -------------
+
+      procedure Destroy (S : in out Instance) is
+      begin
+         Hashed_Set.Destroy (Hashed_Set.Instance (S));
+      end Destroy;
+
+      --------------
+      -- Has_Next --
+      --------------
+
+      function Has_Next (Iter : Iterator) return Boolean is
+      begin
+         return Hashed_Set.Has_Next (Hashed_Set.Iterator (Iter));
+      end Has_Next;
+
+      ------------
+      -- Insert --
+      ------------
+
+      procedure Insert (S : Instance; Elem : Element_Type) is
+      begin
+         Hashed_Set.Put (Hashed_Set.Instance (S), Elem, True);
+      end Insert;
+
+      --------------
+      -- Is_Empty --
+      --------------
+
+      function Is_Empty (S : Instance) return Boolean is
+      begin
+         return Hashed_Set.Is_Empty (Hashed_Set.Instance (S));
+      end Is_Empty;
+
+      -------------
+      -- Iterate --
+      -------------
+
+      function Iterate (S : Instance) return Iterator is
+      begin
+         return Iterator (Hashed_Set.Iterate (Hashed_Set.Instance (S)));
+      end Iterate;
+
+      ----------
+      -- Next --
+      ----------
+
+      procedure Next (Iter : in out Iterator; Elem : out Element_Type) is
+      begin
+         Hashed_Set.Next (Hashed_Set.Iterator (Iter), Elem);
+      end Next;
+
+      ----------
+      -- Size --
+      ----------
+
+      function Size (S : Instance) return Natural is
+      begin
+         return Hashed_Set.Size (Hashed_Set.Instance (S));
+      end Size;
+   end Membership_Set;
+
+end GNAT.Sets;

gcc/ada/libgnat/g-sets.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--                            G N A T . S E T S                             --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--                        Copyright (C) 2018, AdaCore                       --
+--                                                                          --
+-- 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;
+
+with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
+
+package GNAT.Sets is
+
+   --------------------
+   -- Membership_Set --
+   --------------------
+
+   --  The following package offers a membership set abstraction with the
+   --  following characteristics:
+   --
+   --    * Creation of multiple instances, of different sizes.
+   --    * Iterable elements.
+   --
+   --  The following use pattern must be employed with this set:
+   --
+   --    Set : Instance := Create (<some size>);
+   --
+   --    <various operations>
+   --
+   --    Destroy (Set);
+   --
+   --  The destruction of the set reclaims all storage occupied by it.
+
+   generic
+      type Element_Type is private;
+
+      with function "="
+             (Left  : Element_Type;
+              Right : Element_Type) return Boolean;
+
+      with function Hash (Key : Element_Type) return Bucket_Range_Type;
+      --  Map an arbitrary key into the range of buckets
+
+   package Membership_Set is
+
+      --------------------
+      -- Set operations --
+      --------------------
+
+      --  The following type denotes a membership set handle. Each instance
+      --  must be created using routine Create.
+
+      type Instance is private;
+      Nil : constant Instance;
+
+      function Contains (S : Instance; Elem : Element_Type) return Boolean;
+      --  Determine whether membership set S contains element Elem
+
+      function Create (Initial_Size : Positive) return Instance;
+      --  Create a new membership set with bucket capacity Initial_Size. This
+      --  routine must be called at the start of the membership set's lifetime.
+
+      procedure Delete (S : Instance; Elem : Element_Type);
+      --  Delete element Elem from membership set S. The routine has no effect
+      --  if the element is not present in the membership set. This action will
+      --  raise Iterated if the membership set has outstanding iterators.
+
+      procedure Destroy (S : in out Instance);
+      --  Destroy the contents of membership set S, rendering it unusable. This
+      --  routine must be called at the end of the membership set's lifetime.
+      --  This action will raise Iterated if the hash table has outstanding
+      --  iterators.
+
+      procedure Insert (S : Instance; Elem : Element_Type);
+      --  Insert element Elem in membership set S. The routine has no effect
+      --  if the element is already present in the membership set. This action
+      --  will raise Iterated if the membership set has outstanding iterators.
+
+      function Is_Empty (S : Instance) return Boolean;
+      --  Determine whether set S is empty
+
+      function Size (S : Instance) return Natural;
+      --  Obtain the number of elements in membership set S
+
+      -------------------------
+      -- Iterator operations --
+      -------------------------
+
+      --  The following type represents an element iterator. An iterator locks
+      --  all mutation operations, and unlocks them once it is exhausted. The
+      --  iterator must be used with the following pattern:
+      --
+      --    Iter := Iterate (My_Set);
+      --    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;
+
+      function Iterate (S : Instance) return Iterator;
+      --  Obtain an iterator over the elements of membership set S. This action
+      --  locks all mutation functionality of the associated membership set.
+
+      function Has_Next (Iter : Iterator) return Boolean;
+      --  Determine whether iterator Iter has more keys to examine. If the
+      --  iterator has been exhausted, restore all mutation functionality of
+      --  the associated membership set.
+
+      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 membership set, and then
+      --  raises Iterator_Exhausted.
+
+   private
+      package Hashed_Set is new Dynamic_HTable
+        (Key_Type              => Element_Type,
+         Value_Type            => Boolean,
+         No_Value              => False,
+         Expansion_Threshold   => 1.5,
+         Expansion_Factor      => 2,
+         Compression_Threshold => 0.3,
+         Compression_Factor    => 2,
+         "="                   => "=",
+         Hash                  => Hash);
+
+      type Instance is new Hashed_Set.Instance;
+      Nil : constant Instance := Instance (Hashed_Set.Nil);
+
+      type Iterator is new Hashed_Set.Iterator;
+   end Membership_Set;
+
+end GNAT.Sets;

gcc/ada/libgnat/gnat.ads

@@ -34,4 +34,24 @@
 package GNAT is
    pragma Pure;
 
+   --  The following type denotes the range of buckets for various hashed
+   --  data structures in the GNAT unit hierarchy.
+
+   type Bucket_Range_Type is mod 2 ** 32;
+
+   --  The following exception is raised whenever an attempt is made to mutate
+   --  the state of a data structure that is being iterated on.
+
+   Iterated : exception;
+
+   --  The following exception is raised when an iterator is exhausted and
+   --  further attempts are made to advance it.
+
+   Iterator_Exhausted : exception;
+
+   --  The following exception is raised whenever an attempt is made to mutate
+   --  the state of a data structure that has not been created yet.
+
+   Not_Created : exception;
+
 end GNAT;

gcc/testsuite/ChangeLog

+2018-09-26  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* gnat.dg/sets1.adb: New testcase.
+	* gnat.dg/dynhash.adb, gnat.dg/linkedlist.adb: Update testcases
+	to new API.
+
 2018-09-26  Thomas Quinot  <quinot@adacore.com>
 
 	* gnat.dg/sso12.adb: New testcase.

gcc/testsuite/gnat.dg/dynhash.adb

 --  { dg-do run }
 
 with Ada.Text_IO;          use Ada.Text_IO;
+with GNAT;                 use GNAT;
 with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
 
 procedure Dynhash is
@@ -14,14 +15,14 @@ procedure Dynhash is
       Expansion_Factor      => 2,
       Compression_Threshold => 0.3,
       Compression_Factor    => 2,
-      Equivalent_Keys       => "=",
+      "="                   => "=",
       Hash                  => Hash);
    use DHT;
 
    function Create_And_Populate
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type) return Instance;
+      Init_Size : Positive) return Instance;
    --  Create a hash table with initial size Init_Size and populate it with
    --  key-value pairs where both keys and values are in the range Low_Key
    --  .. High_Key.
@@ -50,19 +51,19 @@ procedure Dynhash is
    procedure Check_Size
      (Caller    : String;
       T         : Instance;
-      Exp_Count : Pair_Count_Type);
+      Exp_Count : Natural);
    --  Ensure that the count of key-value pairs of hash table T matches
    --  expected count Exp_Count. Emit an error if this is not the case.
 
-   procedure Test_Create (Init_Size : Bucket_Range_Type);
+   procedure Test_Create (Init_Size : Positive);
    --  Verify that all dynamic hash table operations fail on a non-created
    --  table of size Init_Size.
 
    procedure Test_Delete_Get_Put_Size
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Exp_Count : Pair_Count_Type;
-      Init_Size : Bucket_Range_Type);
+      Exp_Count : Natural;
+      Init_Size : Positive);
    --  Verify that
    --
    --    * Put properly inserts values in the hash table.
@@ -78,7 +79,7 @@ procedure Dynhash is
    procedure Test_Iterate
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type);
+      Init_Size : Positive);
    --  Verify that iterators
    --
    --    * Properly visit each key exactly once.
@@ -88,7 +89,7 @@ procedure Dynhash is
    --  Low_Key and High_Key denote the range of keys to be inserted, retrieved,
    --  and deleted. Init_Size denotes the initial size of the table.
 
-   procedure Test_Iterate_Empty (Init_Size : Bucket_Range_Type);
+   procedure Test_Iterate_Empty (Init_Size : Positive);
    --  Verify that an iterator over an empty hash table
    --
    --    * Does not visit any key
@@ -100,7 +101,7 @@ procedure Dynhash is
    procedure Test_Iterate_Forced
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type);
+      Init_Size : Positive);
    --  Verify that an iterator that is forcefully advanced by just Next
    --
    --    * Properly visit each key exactly once.
@@ -113,7 +114,7 @@ procedure Dynhash is
    procedure Test_Replace
      (Low_Val   : Integer;
       High_Val  : Integer;
-      Init_Size : Bucket_Range_Type);
+      Init_Size : Positive);
    --  Verify that Put properly updates the value of a particular key. Low_Val
    --  and High_Val denote the range of values to be updated. Init_Size denotes
    --  the initial size of the table.
@@ -121,7 +122,7 @@ procedure Dynhash is
    procedure Test_Reset
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type);
+      Init_Size : Positive);
    --  Verify that Reset properly destroy and recreats a hash table. Low_Key
    --  and High_Key denote the range of keys to be inserted in the hash table.
    --  Init_Size denotes the initial size of the table.
@@ -133,7 +134,7 @@ procedure Dynhash is
    function Create_And_Populate
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type) return Instance
+      Init_Size : Positive) return Instance
    is
       T : Instance;
 
@@ -232,7 +233,7 @@ procedure Dynhash is
          Delete (T, 1);
          Put_Line ("ERROR: " & Caller & ": Delete: no exception raised");
       exception
-         when Table_Locked =>
+         when Iterated =>
             null;
          when others =>
            Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
@@ -242,7 +243,7 @@ procedure Dynhash is
          Destroy (T);
          Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised");
       exception
-         when Table_Locked =>
+         when Iterated =>
             null;
          when others =>
            Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception");
@@ -252,7 +253,7 @@ procedure Dynhash is
          Put (T, 1, 1);
          Put_Line ("ERROR: " & Caller & ": Put: no exception raised");
       exception
-         when Table_Locked =>
+         when Iterated =>
             null;
          when others =>
            Put_Line ("ERROR: " & Caller & ": Put: unexpected exception");
@@ -262,7 +263,7 @@ procedure Dynhash is
          Reset (T);
          Put_Line ("ERROR: " & Caller & ": Reset: no exception raised");
       exception
-         when Table_Locked =>
+         when Iterated =>
             null;
          when others =>
            Put_Line ("ERROR: " & Caller & ": Reset: unexpected exception");
@@ -273,12 +274,12 @@ procedure Dynhash is
    -- Check_Size --
    ----------------
 
-   procedure Check_Size
+   procedure Check_Size 
      (Caller    : String;
       T         : Instance;
-      Exp_Count : Pair_Count_Type)
+      Exp_Count : Natural)
    is
-      Count : constant Pair_Count_Type := Size (T);
+      Count : constant Natural := Size (T);
 
    begin
       if Count /= Exp_Count then
@@ -301,8 +302,8 @@ procedure Dynhash is
    -- Test_Create --
    -----------------
 
-   procedure Test_Create (Init_Size : Bucket_Range_Type) is
-      Count : Pair_Count_Type;
+   procedure Test_Create (Init_Size : Positive) is
+      Count : Natural;
       Iter  : Iterator;
       T     : Instance;
       Val   : Integer;
@@ -397,8 +398,8 @@ procedure Dynhash is
    procedure Test_Delete_Get_Put_Size
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Exp_Count : Pair_Count_Type;
-      Init_Size : Bucket_Range_Type)
+      Exp_Count : Natural;
+      Init_Size : Positive)
    is
       Exp_Val : Integer;
       T       : Instance;
@@ -478,7 +479,7 @@ procedure Dynhash is
    procedure Test_Iterate
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type)
+      Init_Size : Positive)
    is
       Iter_1 : Iterator;
       Iter_2 : Iterator;
@@ -527,7 +528,7 @@ procedure Dynhash is
       --  operations of the hash table because all outstanding iterators have
       --  been exhausted.
 
-      Check_Keys
+      Check_Keys 
         (Caller   => "Test_Iterate",
          Iter     => Iter_2,
          Low_Key  => Low_Key,
@@ -548,7 +549,7 @@ procedure Dynhash is
    -- Test_Iterate_Empty --
    ------------------------
 
-   procedure Test_Iterate_Empty (Init_Size : Bucket_Range_Type) is
+   procedure Test_Iterate_Empty (Init_Size : Positive) is
       Iter : Iterator;
       Key  : Integer;
       T    : Instance;
@@ -594,7 +595,7 @@ procedure Dynhash is
    procedure Test_Iterate_Forced
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type)
+      Init_Size : Positive)
    is
       Iter : Iterator;
       Key  : Integer;
@@ -649,7 +650,7 @@ procedure Dynhash is
    procedure Test_Replace
      (Low_Val   : Integer;
       High_Val  : Integer;
-      Init_Size : Bucket_Range_Type)
+      Init_Size : Positive)
    is
       Key : constant Integer := 1;
       T   : Instance;
@@ -681,10 +682,10 @@ procedure Dynhash is
    -- Test_Reset --
    ----------------
 
-   procedure Test_Reset
+   procedure Test_Reset 
      (Low_Key   : Integer;
       High_Key  : Integer;
-      Init_Size : Bucket_Range_Type)
+      Init_Size : Positive)
    is
       T : Instance;
 

gcc/testsuite/gnat.dg/linkedlist.adb

 --  { dg-do run }
 
 with Ada.Text_IO; use Ada.Text_IO;
+with GNAT;        use GNAT;
 with GNAT.Lists;  use GNAT.Lists;
 
 procedure Linkedlist is
@@ -97,15 +98,15 @@ procedure Linkedlist is
    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
 
+   procedure Test_Size;
+   --  Verify that Size returns the correct size of a list
+
    -----------------
    -- Check_Empty --
    -----------------
@@ -116,7 +117,7 @@ procedure Linkedlist is
       Low_Elem  : Integer;
       High_Elem : Integer)
    is
-      Len : constant Element_Count_Type := Length (L);
+      Len : constant Natural := Size (L);
 
    begin
       for Elem in Low_Elem .. High_Elem loop
@@ -142,7 +143,7 @@ procedure Linkedlist is
          Append (L, 1);
          Put_Line ("ERROR: " & Caller & ": Append: no exception raised");
       exception
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line ("ERROR: " & Caller & ": Append: unexpected exception");
@@ -154,7 +155,7 @@ procedure Linkedlist is
       exception
          when List_Empty =>
             null;
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
@@ -166,7 +167,7 @@ procedure Linkedlist is
       exception
          when List_Empty =>
             null;
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line
@@ -179,10 +180,10 @@ procedure Linkedlist is
       exception
          when List_Empty =>
             null;
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
-            Put_Line
+            Put_Line 
               ("ERROR: " & Caller & ": Delete_Last: unexpected exception");
       end;
 
@@ -190,7 +191,7 @@ procedure Linkedlist is
          Destroy (L);
          Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised");
       exception
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception");
@@ -200,10 +201,10 @@ procedure Linkedlist is
          Insert_After (L, 1, 2);
          Put_Line ("ERROR: " & Caller & ": Insert_After: no exception raised");
       exception
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
-            Put_Line
+            Put_Line 
               ("ERROR: " & Caller & ": Insert_After: unexpected exception");
       end;
 
@@ -212,7 +213,7 @@ procedure Linkedlist is
          Put_Line
            ("ERROR: " & Caller & ": Insert_Before: no exception raised");
       exception
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line
@@ -223,7 +224,7 @@ procedure Linkedlist is
          Prepend (L, 1);
          Put_Line ("ERROR: " & Caller & ": Prepend: no exception raised");
       exception
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line ("ERROR: " & Caller & ": Prepend: unexpected exception");
@@ -233,7 +234,7 @@ procedure Linkedlist is
          Replace (L, 1, 2);
          Put_Line ("ERROR: " & Caller & ": Replace: no exception raised");
       exception
-         when List_Locked =>
+         when Iterated =>
             null;
          when others =>
             Put_Line ("ERROR: " & Caller & ": Replace: unexpected exception");
@@ -384,7 +385,7 @@ procedure Linkedlist is
    -----------------
 
    procedure Test_Create is
-      Count : Element_Count_Type;
+      Count : Natural;
       Flag  : Boolean;
       Iter  : Iterator;
       L     : Instance;
@@ -508,33 +509,33 @@ procedure Linkedlist is
       end;
 
       begin
-         Count := Length (L);
-         Put_Line ("ERROR: Test_Create: Length: no exception raised");
+         Prepend (L, 1);
+         Put_Line ("ERROR: Test_Create: Prepend: no exception raised");
       exception
          when Not_Created =>
             null;
          when others =>
-            Put_Line ("ERROR: Test_Create: Length: unexpected exception");
+            Put_Line ("ERROR: Test_Create: Prepend: unexpected exception");
       end;
 
       begin
-         Prepend (L, 1);
-         Put_Line ("ERROR: Test_Create: Prepend: no exception raised");
+         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: Prepend: unexpected exception");
+            Put_Line ("ERROR: Test_Create: Replace: unexpected exception");
       end;
 
       begin
-         Replace (L, 1, 2);
-         Put_Line ("ERROR: Test_Create: Replace: no exception raised");
+         Count := Size (L);
+         Put_Line ("ERROR: Test_Create: Size: no exception raised");
       exception
          when Not_Created =>
             null;
          when others =>
-            Put_Line ("ERROR: Test_Create: Replace: unexpected exception");
+            Put_Line ("ERROR: Test_Create: Size: unexpected exception");
       end;
    end Test_Create;
 
@@ -654,7 +655,7 @@ procedure Linkedlist is
 
       --  At this point the list should be completely empty
 
-      Check_Empty
+      Check_Empty 
         (Caller    => "Test_Delete_First",
          L         => L,
          Low_Elem  => Low_Elem,
@@ -1055,44 +1056,6 @@ procedure Linkedlist is
       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 --
    ------------------
@@ -1143,6 +1106,44 @@ procedure Linkedlist is
       Destroy (L);
    end Test_Replace;
 
+   ---------------
+   -- Test_Size --
+   ---------------
+
+   procedure Test_Size is
+      L : Instance := 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
@@ -1178,7 +1179,7 @@ begin
       High_Elem => 5);
 
    Test_Last;
-   Test_Length;
    Test_Prepend;
    Test_Replace;
+   Test_Size;
 end Linkedlist;