Skip to content

R
riscv-gcc-1
Commit 1d88851c by Hristian Kirtchev Committed by Pierre-Marie de Rodat
Options

[Ada] Clean up of GNAT.Sets 

------------
-- Source --
------------

--  operations.adb

with Ada.Text_IO; use Ada.Text_IO;
with GNAT;        use GNAT;
with GNAT.Sets;   use GNAT.Sets;

procedure Operations is
   function Hash (Key : Integer) return Bucket_Range_Type;

   package Integer_Sets is new Membership_Sets
     (Element_Type => Integer,
      "="          => "=",
      Hash         => Hash);
   use Integer_Sets;

   procedure Check_Empty
     (Caller    : String;
      S         : Membership_Set;
      Low_Elem  : Integer;
      High_Elem : Integer);
   --  Ensure that none of the elements in the range Low_Elem .. High_Elem are
   --  present in set S, and that the set's length is 0.

   procedure Check_Locked_Mutations
     (Caller : String;
      S      : in out Membership_Set);
   --  Ensure that all mutation operations of set S are locked

   procedure Check_Present
     (Caller    : String;
      S         : Membership_Set;
      Low_Elem  : Integer;
      High_Elem : Integer);
   --  Ensure that all elements in the range Low_Elem .. High_Elem are present
   --  in set S.

   procedure Check_Unlocked_Mutations
     (Caller : String;
      S      : in out Membership_Set);
   --  Ensure that all mutation operations of set S are unlocked

   procedure Populate
     (S         : Membership_Set;
      Low_Elem  : Integer;
      High_Elem : Integer);
   --  Add elements in the range Low_Elem .. High_Elem in set S

   procedure Test_Contains
     (Low_Elem  : Integer;
      High_Elem : Integer;
      Init_Size : Positive);
   --  Verify that Contains properly identifies that elements in the range
   --  Low_Elem .. High_Elem are within a set. Init_Size denotes the initial
   --  size of the set.

   procedure Test_Create;
   --  Verify that all set operations fail on a non-created set

   procedure Test_Delete
     (Low_Elem  : Integer;
      High_Elem : Integer;
      Init_Size : Positive);
   --  Verify that Delete properly removes elements in the range Low_Elem ..
   --  High_Elem from a set. Init_Size denotes the initial size of the set.

   procedure Test_Is_Empty;
   --  Verify that Is_Empty properly returns this status of a set

   procedure Test_Iterate;
   --  Verify that iterators properly manipulate mutation operations

   procedure Test_Iterate_Empty;
   --  Verify that iterators properly manipulate mutation operations of an
   --  empty set.

   procedure Test_Iterate_Forced
     (Low_Elem  : Integer;
      High_Elem : Integer;
      Init_Size : Positive);
   --  Verify that an iterator that is forcefully advanced by Next properly
   --  unlocks the mutation operations of a set. Init_Size denotes the initial
   --  size of the set.

   procedure Test_Size;
   --  Verify that Size returns the correct size of a set

   -----------------
   -- Check_Empty --
   -----------------

   procedure Check_Empty
     (Caller    : String;
      S         : Membership_Set;
      Low_Elem  : Integer;
      High_Elem : Integer)
   is
      Siz : constant Natural := Size (S);

   begin
      for Elem in Low_Elem .. High_Elem loop
         if Contains (S, Elem) then
            Put_Line ("ERROR: " & Caller & ": extra element" & Elem'Img);
         end if;
      end loop;

      if Siz /= 0 then
         Put_Line ("ERROR: " & Caller & ": wrong size");
         Put_Line ("expected: 0");
         Put_Line ("got     :" & Siz'Img);
      end if;
   end Check_Empty;

   ----------------------------
   -- Check_Locked_Mutations --
   ----------------------------

   procedure Check_Locked_Mutations
     (Caller : String;
      S      : in out Membership_Set)
   is
   begin
      begin
         Delete (S, 1);
         Put_Line ("ERROR: " & Caller & ": Delete: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Delete: unexpected exception");
      end;

      begin
         Destroy (S);
         Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception");
      end;

      begin
         Insert (S, 1);
         Put_Line ("ERROR: " & Caller & ": Insert: no exception raised");
      exception
         when Iterated =>
            null;
         when others =>
            Put_Line ("ERROR: " & Caller & ": Insert: unexpected exception");
      end;
   end Check_Locked_Mutations;

   -------------------
   -- Check_Present --
   -------------------

   procedure Check_Present
     (Caller    : String;
      S         : Membership_Set;
      Low_Elem  : Integer;
      High_Elem : Integer)
   is
      Elem : Integer;
      Iter : Iterator;

   begin
      Iter := Iterate (S);
      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;
      S      : in out Membership_Set)
   is
   begin
      Delete (S, 1);
      Insert (S, 1);
   end Check_Unlocked_Mutations;

   ----------
   -- Hash --
   ----------

   function Hash (Key : Integer) return Bucket_Range_Type is
   begin
      return Bucket_Range_Type (Key);
   end Hash;

   --------------
   -- Populate --
   --------------

   procedure Populate
     (S         : Membership_Set;
      Low_Elem  : Integer;
      High_Elem : Integer)
   is
   begin
      for Elem in Low_Elem .. High_Elem loop
         Insert (S, Elem);
      end loop;
   end Populate;

   -------------------
   -- Test_Contains --
   -------------------

   procedure Test_Contains
     (Low_Elem  : Integer;
      High_Elem : Integer;
      Init_Size : Positive)
   is
      Low_Bogus  : constant Integer := Low_Elem  - 1;
      High_Bogus : constant Integer := High_Elem + 1;

      S : Membership_Set := Create (Init_Size);

   begin
      Populate (S, Low_Elem, High_Elem);

      --  Ensure that the elements are contained in the set

      for Elem in Low_Elem .. High_Elem loop
         if not Contains (S, Elem) then
            Put_Line
              ("ERROR: Test_Contains: element" & Elem'Img & " not in set");
         end if;
      end loop;

      --  Ensure that arbitrary elements which were not inserted in the set are
      --  not contained in the set.

      if Contains (S, Low_Bogus) then
         Put_Line
           ("ERROR: Test_Contains: element" & Low_Bogus'Img & " in set");
      end if;

      if Contains (S, High_Bogus) then
         Put_Line
           ("ERROR: Test_Contains: element" & High_Bogus'Img & " in set");
      end if;

      Destroy (S);
   end Test_Contains;

   -----------------
   -- Test_Create --
   -----------------

   procedure Test_Create is
      Count : Natural;
      Flag  : Boolean;
      Iter  : Iterator;
      S     : Membership_Set;

   begin
      --  Ensure that every routine defined in the API fails on a set which
      --  has not been created yet.

      begin
         Flag := Contains (S, 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 (S, 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
         Insert (S, 1);
         Put_Line ("ERROR: Test_Create: Insert: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Insert: unexpected exception");
      end;

      begin
         Flag := Is_Empty (S);
         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 (S);
         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
         Count := Size (S);
         Put_Line ("ERROR: Test_Create: Size: no exception raised");
      exception
         when Not_Created =>
            null;
         when others =>
            Put_Line ("ERROR: Test_Create: Size: unexpected exception");
      end;
   end Test_Create;

   -----------------
   -- Test_Delete --
   -----------------

   procedure Test_Delete
     (Low_Elem  : Integer;
      High_Elem : Integer;
      Init_Size : Positive)
   is
      Iter : Iterator;
      S    : Membership_Set := Create (Init_Size);

   begin
      Populate (S, Low_Elem, High_Elem);

      --  Delete all even elements

      for Elem in Low_Elem .. High_Elem loop
         if Elem mod 2 = 0 then
            Delete (S, Elem);
         end if;
      end loop;

      --  Ensure that all remaining odd elements are present in the set

      for Elem in Low_Elem .. High_Elem loop
         if Elem mod 2 /= 0 and then not Contains (S, Elem) then
            Put_Line ("ERROR: Test_Delete: missing element" & Elem'Img);
         end if;
      end loop;

      --  Delete all odd elements

      for Elem in Low_Elem .. High_Elem loop
         if Elem mod 2 /= 0 then
            Delete (S, Elem);
         end if;
      end loop;

      --  At this point the set should be completely empty

      Check_Empty
        (Caller    => "Test_Delete",
         S         => S,
         Low_Elem  => Low_Elem,
         High_Elem => High_Elem);

      Destroy (S);
   end Test_Delete;

   -------------------
   -- Test_Is_Empty --
   -------------------

   procedure Test_Is_Empty is
      S : Membership_Set := Create (8);

   begin
      if not Is_Empty (S) then
         Put_Line ("ERROR: Test_Is_Empty: set is not empty");
      end if;

      Insert (S, 1);

      if Is_Empty (S) then
         Put_Line ("ERROR: Test_Is_Empty: set is empty");
      end if;

      Delete (S, 1);

      if not Is_Empty (S) then
         Put_Line ("ERROR: Test_Is_Empty: set is not empty");
      end if;

      Destroy (S);
   end Test_Is_Empty;

   ------------------
   -- Test_Iterate --
   ------------------

   procedure Test_Iterate is
      Elem   : Integer;
      Iter_1 : Iterator;
      Iter_2 : Iterator;
      S      : Membership_Set := Create (5);

   begin
      Populate (S, 1, 5);

      --  Obtain an iterator. This action must lock all mutation operations of
      --  the set.

      Iter_1 := Iterate (S);

      --  Ensure that every mutation routine defined in the API fails on a set
      --  with at least one outstanding iterator.

      Check_Locked_Mutations
        (Caller => "Test_Iterate",
         S      => S);

      --  Obtain another iterator

      Iter_2 := Iterate (S);

      --  Ensure that every mutation is still locked

      Check_Locked_Mutations
        (Caller => "Test_Iterate",
         S      => S);

      --  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",
         S      => S);

      --  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",
         S      => S);

      Destroy (S);
   end Test_Iterate;

   ------------------------
   -- Test_Iterate_Empty --
   ------------------------

   procedure Test_Iterate_Empty is
      Elem : Integer;
      Iter : Iterator;
      S    : Membership_Set := Create (5);

   begin
      --  Obtain an iterator. This action must lock all mutation operations of
      --  the set.

      Iter := Iterate (S);

      --  Ensure that every mutation routine defined in the API fails on a set
      --  with at least one outstanding iterator.

      Check_Locked_Mutations
        (Caller => "Test_Iterate_Empty",
         S      => S);

      --  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",
         S      => S);

      Destroy (S);
   end Test_Iterate_Empty;

   -------------------------
   -- Test_Iterate_Forced --
   -------------------------

   procedure Test_Iterate_Forced
     (Low_Elem  : Integer;
      High_Elem : Integer;
      Init_Size : Positive)
   is
      Elem : Integer;
      Iter : Iterator;
      S    : Membership_Set := Create (Init_Size);

   begin
      Populate (S, Low_Elem, High_Elem);

      --  Obtain an iterator. This action must lock all mutation operations of
      --  the set.

      Iter := Iterate (S);

      --  Ensure that every mutation routine defined in the API fails on a set
      --  with at least one outstanding iterator.

      Check_Locked_Mutations
        (Caller => "Test_Iterate_Forced",
         S      => S);

      --  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",
         S      => S);

      Destroy (S);
   end Test_Iterate_Forced;

   ---------------
   -- Test_Size --
   ---------------

   procedure Test_Size is
      S   : Membership_Set := Create (6);
      Siz : Natural;

   begin
      Siz := Size (S);

      if Siz /= 0 then
         Put_Line ("ERROR: Test_Size: wrong size");
         Put_Line ("expected: 0");
         Put_Line ("got     :" & Siz'Img);
      end if;

      Populate (S, 1, 2);
      Siz := Size (S);

      if Siz /= 2 then
         Put_Line ("ERROR: Test_Size: wrong size");
         Put_Line ("expected: 2");
         Put_Line ("got     :" & Siz'Img);
      end if;

      Populate (S, 3, 6);
      Siz := Size (S);

      if Siz /= 6 then
         Put_Line ("ERROR: Test_Size: wrong size");
         Put_Line ("expected: 6");
         Put_Line ("got     :" & Siz'Img);
      end if;

      Destroy (S);
   end Test_Size;

--  Start of processing for Operations

begin
   Test_Contains
     (Low_Elem  => 1,
      High_Elem => 5,
      Init_Size => 5);

   Test_Create;

   Test_Delete
     (Low_Elem  => 1,
      High_Elem => 10,
      Init_Size => 10);

   Test_Is_Empty;
   Test_Iterate;
   Test_Iterate_Empty;

   Test_Iterate_Forced
     (Low_Elem  => 1,
      High_Elem => 5,
      Init_Size => 5);

   Test_Size;
end Operations;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q operations.adb -largs -lgmem
$ ./operations
$ gnatmem operations > leaks.txt
$ grep -c "non freed allocations" leaks.txt
0

2019-07-01  Hristian Kirtchev  <kirtchev@adacore.com>

gcc/ada/

	* libgnat/g-sets.adb: Use type Membership_Set rathern than
	Instance in various routines.
	* libgnat/g-sets.ads: Change type Instance to Membership_Set.
	Update various routines that mention the type.

gcc/testsuite/

	* gnat.dg/sets1.adb: Update.

From-SVN: r272862
parent 02fd808c
Showing with 100 additions and 63 deletions
gcc/ada/ChangeLog
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com> 2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* libgnat/g-sets.adb: Use type Membership_Set rathern than
Instance in various routines.
* libgnat/g-sets.ads: Change type Instance to Membership_Set.
Update various routines that mention the type.
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* libgnat/g-lists.adb: Use type Doubly_Linked_List rather than * libgnat/g-lists.adb: Use type Doubly_Linked_List rather than
Instance in various routines. Instance in various routines.
* libgnat/g-lists.ads: Change type Instance to * libgnat/g-lists.ads: Change type Instance to
......
gcc/ada/libgnat/g-sets.adb
...@@ -31,37 +31,40 @@ ...@@ -31,37 +31,40 @@
package body GNAT.Sets is package body GNAT.Sets is
-------------------- ---------------------
-- Membership_Set -- -- Membership_Sets --
-------------------- ---------------------
package body Membership_Set is package body Membership_Sets is
-------------- --------------
-- Contains -- -- Contains --
-------------- --------------
function Contains (S : Instance; Elem : Element_Type) return Boolean is function Contains
(S : Membership_Set;
Elem : Element_Type) return Boolean
is
begin begin
return Hashed_Set.Get (Hashed_Set.Instance (S), Elem); return Hashed_Set.Get (Hashed_Set.Dynamic_Hash_Table (S), Elem);
end Contains; end Contains;
------------ ------------
-- Create -- -- Create --
------------ ------------
function Create (Initial_Size : Positive) return Instance is function Create (Initial_Size : Positive) return Membership_Set is
begin begin
return Instance (Hashed_Set.Create (Initial_Size)); return Membership_Set (Hashed_Set.Create (Initial_Size));
end Create; end Create;
------------ ------------
-- Delete -- -- Delete --
------------ ------------
procedure Delete (S : Instance; Elem : Element_Type) is procedure Delete (S : Membership_Set; Elem : Element_Type) is
begin begin
Hashed_Set.Delete (Hashed_Set.Instance (S), Elem); Hashed_Set.Delete (Hashed_Set.Dynamic_Hash_Table (S), Elem);
end Delete; end Delete;
------------- -------------
...@@ -78,9 +81,9 @@ package body GNAT.Sets is ...@@ -78,9 +81,9 @@ package body GNAT.Sets is
-- Destroy -- -- Destroy --
------------- -------------
procedure Destroy (S : in out Instance) is procedure Destroy (S : in out Membership_Set) is
begin begin
Hashed_Set.Destroy (Hashed_Set.Instance (S)); Hashed_Set.Destroy (Hashed_Set.Dynamic_Hash_Table (S));
end Destroy; end Destroy;
-------------- --------------
...@@ -96,34 +99,41 @@ package body GNAT.Sets is ...@@ -96,34 +99,41 @@ package body GNAT.Sets is
-- Insert -- -- Insert --
------------ ------------
procedure Insert (S : Instance; Elem : Element_Type) is procedure Insert
(S : Membership_Set;
Elem : Element_Type)
is
begin begin
Hashed_Set.Put (Hashed_Set.Instance (S), Elem, True); Hashed_Set.Put (Hashed_Set.Dynamic_Hash_Table (S), Elem, True);
end Insert; end Insert;
-------------- --------------
-- Is_Empty -- -- Is_Empty --
-------------- --------------
function Is_Empty (S : Instance) return Boolean is function Is_Empty (S : Membership_Set) return Boolean is
begin begin
return Hashed_Set.Is_Empty (Hashed_Set.Instance (S)); return Hashed_Set.Is_Empty (Hashed_Set.Dynamic_Hash_Table (S));
end Is_Empty; end Is_Empty;
------------- -------------
-- Iterate -- -- Iterate --
------------- -------------
function Iterate (S : Instance) return Iterator is function Iterate (S : Membership_Set) return Iterator is
begin begin
return Iterator (Hashed_Set.Iterate (Hashed_Set.Instance (S))); return
Iterator (Hashed_Set.Iterate (Hashed_Set.Dynamic_Hash_Table (S)));
end Iterate; end Iterate;
---------- ----------
-- Next -- -- Next --
---------- ----------
procedure Next (Iter : in out Iterator; Elem : out Element_Type) is procedure Next
(Iter : in out Iterator;
Elem : out Element_Type)
is
begin begin
Hashed_Set.Next (Hashed_Set.Iterator (Iter), Elem); Hashed_Set.Next (Hashed_Set.Iterator (Iter), Elem);
end Next; end Next;
...@@ -132,28 +142,28 @@ package body GNAT.Sets is ...@@ -132,28 +142,28 @@ package body GNAT.Sets is
-- Present -- -- Present --
------------- -------------
function Present (S : Instance) return Boolean is function Present (S : Membership_Set) return Boolean is
begin begin
return Hashed_Set.Present (Hashed_Set.Instance (S)); return Hashed_Set.Present (Hashed_Set.Dynamic_Hash_Table (S));
end Present; end Present;
----------- -----------
-- Reset -- -- Reset --
----------- -----------
procedure Reset (S : Instance) is procedure Reset (S : Membership_Set) is
begin begin
Hashed_Set.Reset (Hashed_Set.Instance (S)); Hashed_Set.Reset (Hashed_Set.Dynamic_Hash_Table (S));
end Reset; end Reset;
---------- ----------
-- Size -- -- Size --
---------- ----------
function Size (S : Instance) return Natural is function Size (S : Membership_Set) return Natural is
begin begin
return Hashed_Set.Size (Hashed_Set.Instance (S)); return Hashed_Set.Size (Hashed_Set.Dynamic_Hash_Table (S));
end Size; end Size;
end Membership_Set; end Membership_Sets;
end GNAT.Sets; end GNAT.Sets;
gcc/ada/libgnat/g-sets.ads
...@@ -47,7 +47,7 @@ package GNAT.Sets is ...@@ -47,7 +47,7 @@ package GNAT.Sets is
-- --
-- The following use pattern must be employed with this set: -- The following use pattern must be employed with this set:
-- --
-- Set : Instance := Create (<some size>); -- Set : Membership_Set := Create (<some size>);
-- --
-- <various operations> -- <various operations>
-- --
...@@ -65,7 +65,7 @@ package GNAT.Sets is ...@@ -65,7 +65,7 @@ package GNAT.Sets is
with function Hash (Key : Element_Type) return Bucket_Range_Type; with function Hash (Key : Element_Type) return Bucket_Range_Type;
-- Map an arbitrary key into the range of buckets -- Map an arbitrary key into the range of buckets
package Membership_Set is package Membership_Sets is
-------------------- --------------------
-- Set operations -- -- Set operations --
...@@ -74,44 +74,50 @@ package GNAT.Sets is ...@@ -74,44 +74,50 @@ package GNAT.Sets is
-- The following type denotes a membership set handle. Each instance -- The following type denotes a membership set handle. Each instance
-- must be created using routine Create. -- must be created using routine Create.
type Instance is private; type Membership_Set is private;
Nil : constant Instance; Nil : constant Membership_Set;
function Contains (S : Instance; Elem : Element_Type) return Boolean; function Contains
(S : Membership_Set;
Elem : Element_Type) return Boolean;
-- Determine whether membership set S contains element Elem -- Determine whether membership set S contains element Elem
function Create (Initial_Size : Positive) return Instance; function Create (Initial_Size : Positive) return Membership_Set;
-- Create a new membership set with bucket capacity Initial_Size. This -- Create a new membership set with bucket capacity Initial_Size. This
-- routine must be called at the start of the membership set's lifetime. -- routine must be called at the start of the membership set's lifetime.
procedure Delete (S : Instance; Elem : Element_Type); procedure Delete
(S : Membership_Set;
Elem : Element_Type);
-- Delete element Elem from membership set S. The routine has no effect -- 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 -- if the element is not present in the membership set. This action will
-- raise Iterated if the membership set has outstanding iterators. -- raise Iterated if the membership set has outstanding iterators.
procedure Destroy (S : in out Instance); procedure Destroy (S : in out Membership_Set);
-- Destroy the contents of membership set S, rendering it unusable. This -- Destroy the contents of membership set S, rendering it unusable. This
-- routine must be called at the end of the membership set's lifetime. -- routine must be called at the end of the membership set's lifetime.
-- This action will raise Iterated if the hash table has outstanding -- This action will raise Iterated if the hash table has outstanding
-- iterators. -- iterators.
procedure Insert (S : Instance; Elem : Element_Type); procedure Insert
(S : Membership_Set;
Elem : Element_Type);
-- Insert element Elem in membership set S. The routine has no effect -- Insert element Elem in membership set S. The routine has no effect
-- if the element is already present in the membership set. This action -- if the element is already present in the membership set. This action
-- will raise Iterated if the membership set has outstanding iterators. -- will raise Iterated if the membership set has outstanding iterators.
function Is_Empty (S : Instance) return Boolean; function Is_Empty (S : Membership_Set) return Boolean;
-- Determine whether set S is empty -- Determine whether set S is empty
function Present (S : Instance) return Boolean; function Present (S : Membership_Set) return Boolean;
-- Determine whether set S exists -- Determine whether set S exists
procedure Reset (S : Instance); procedure Reset (S : Membership_Set);
-- Destroy the contents of membership set S, and reset it to its initial -- Destroy the contents of membership set S, and reset it to its initial
-- created state. This action will raise Iterated if the membership set -- created state. This action will raise Iterated if the membership set
-- has outstanding iterators. -- has outstanding iterators.
function Size (S : Instance) return Natural; function Size (S : Membership_Set) return Natural;
-- Obtain the number of elements in membership set S -- Obtain the number of elements in membership set S
------------------------- -------------------------
...@@ -132,7 +138,7 @@ package GNAT.Sets is ...@@ -132,7 +138,7 @@ package GNAT.Sets is
type Iterator is private; type Iterator is private;
function Iterate (S : Instance) return Iterator; function Iterate (S : Membership_Set) return Iterator;
-- Obtain an iterator over the elements of membership set S. This action -- Obtain an iterator over the elements of membership set S. This action
-- locks all mutation functionality of the associated membership set. -- locks all mutation functionality of the associated membership set.
...@@ -152,7 +158,7 @@ package GNAT.Sets is ...@@ -152,7 +158,7 @@ package GNAT.Sets is
procedure Destroy (B : in out Boolean); procedure Destroy (B : in out Boolean);
-- Destroy boolean B -- Destroy boolean B
package Hashed_Set is new Dynamic_HTable package Hashed_Set is new Dynamic_Hash_Tables
(Key_Type => Element_Type, (Key_Type => Element_Type,
Value_Type => Boolean, Value_Type => Boolean,
No_Value => False, No_Value => False,
...@@ -164,10 +170,10 @@ package GNAT.Sets is ...@@ -164,10 +170,10 @@ package GNAT.Sets is
Destroy_Value => Destroy, Destroy_Value => Destroy,
Hash => Hash); Hash => Hash);
type Instance is new Hashed_Set.Instance; type Membership_Set is new Hashed_Set.Dynamic_Hash_Table;
Nil : constant Instance := Instance (Hashed_Set.Nil); Nil : constant Membership_Set := Membership_Set (Hashed_Set.Nil);
type Iterator is new Hashed_Set.Iterator; type Iterator is new Hashed_Set.Iterator;
end Membership_Set; end Membership_Sets;
end GNAT.Sets; end GNAT.Sets;
gcc/testsuite/ChangeLog
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com> 2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/sets1.adb: Update.
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
* gnat.dg/linkedlist.adb: Update. * gnat.dg/linkedlist.adb: Update.
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com> 2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
......
gcc/testsuite/gnat.dg/sets1.adb
...@@ -7,7 +7,7 @@ with GNAT.Sets; use GNAT.Sets; ...@@ -7,7 +7,7 @@ with GNAT.Sets; use GNAT.Sets;
procedure Sets1 is procedure Sets1 is
function Hash (Key : Integer) return Bucket_Range_Type; function Hash (Key : Integer) return Bucket_Range_Type;
package Integer_Sets is new Membership_Set package Integer_Sets is new Membership_Sets
(Element_Type => Integer, (Element_Type => Integer,
"=" => "=", "=" => "=",
Hash => Hash); Hash => Hash);
...@@ -15,28 +15,32 @@ procedure Sets1 is ...@@ -15,28 +15,32 @@ procedure Sets1 is
procedure Check_Empty procedure Check_Empty
(Caller : String; (Caller : String;
S : Instance; S : Membership_Set;
Low_Elem : Integer; Low_Elem : Integer;
High_Elem : Integer); High_Elem : Integer);
-- Ensure that none of the elements in the range Low_Elem .. High_Elem are -- Ensure that none of the elements in the range Low_Elem .. High_Elem are
-- present in set S, and that the set's length is 0. -- present in set S, and that the set's length is 0.
procedure Check_Locked_Mutations (Caller : String; S : in out Instance); procedure Check_Locked_Mutations
(Caller : String;
S : in out Membership_Set);
-- Ensure that all mutation operations of set S are locked -- Ensure that all mutation operations of set S are locked
procedure Check_Present procedure Check_Present
(Caller : String; (Caller : String;
S : Instance; S : Membership_Set;
Low_Elem : Integer; Low_Elem : Integer;
High_Elem : Integer); High_Elem : Integer);
-- Ensure that all elements in the range Low_Elem .. High_Elem are present -- Ensure that all elements in the range Low_Elem .. High_Elem are present
-- in set S. -- in set S.
procedure Check_Unlocked_Mutations (Caller : String; S : in out Instance); procedure Check_Unlocked_Mutations
(Caller : String;
S : in out Membership_Set);
-- Ensure that all mutation operations of set S are unlocked -- Ensure that all mutation operations of set S are unlocked
procedure Populate procedure Populate
(S : Instance; (S : Membership_Set;
Low_Elem : Integer; Low_Elem : Integer;
High_Elem : Integer); High_Elem : Integer);
-- Add elements in the range Low_Elem .. High_Elem in set S -- Add elements in the range Low_Elem .. High_Elem in set S
...@@ -86,7 +90,7 @@ procedure Sets1 is ...@@ -86,7 +90,7 @@ procedure Sets1 is
procedure Check_Empty procedure Check_Empty
(Caller : String; (Caller : String;
S : Instance; S : Membership_Set;
Low_Elem : Integer; Low_Elem : Integer;
High_Elem : Integer) High_Elem : Integer)
is is
...@@ -110,7 +114,10 @@ procedure Sets1 is ...@@ -110,7 +114,10 @@ procedure Sets1 is
-- Check_Locked_Mutations -- -- Check_Locked_Mutations --
---------------------------- ----------------------------
procedure Check_Locked_Mutations (Caller : String; S : in out Instance) is procedure Check_Locked_Mutations
(Caller : String;
S : in out Membership_Set)
is
begin begin
begin begin
Delete (S, 1); Delete (S, 1);
...@@ -149,7 +156,7 @@ procedure Sets1 is ...@@ -149,7 +156,7 @@ procedure Sets1 is
procedure Check_Present procedure Check_Present
(Caller : String; (Caller : String;
S : Instance; S : Membership_Set;
Low_Elem : Integer; Low_Elem : Integer;
High_Elem : Integer) High_Elem : Integer)
is is
...@@ -189,7 +196,10 @@ procedure Sets1 is ...@@ -189,7 +196,10 @@ procedure Sets1 is
-- Check_Unlocked_Mutations -- -- Check_Unlocked_Mutations --
------------------------------ ------------------------------
procedure Check_Unlocked_Mutations (Caller : String; S : in out Instance) is procedure Check_Unlocked_Mutations
(Caller : String;
S : in out Membership_Set)
is
begin begin
Delete (S, 1); Delete (S, 1);
Insert (S, 1); Insert (S, 1);
...@@ -209,7 +219,7 @@ procedure Sets1 is ...@@ -209,7 +219,7 @@ procedure Sets1 is
-------------- --------------
procedure Populate procedure Populate
(S : Instance; (S : Membership_Set;
Low_Elem : Integer; Low_Elem : Integer;
High_Elem : Integer) High_Elem : Integer)
is is
...@@ -231,7 +241,7 @@ procedure Sets1 is ...@@ -231,7 +241,7 @@ procedure Sets1 is
Low_Bogus : constant Integer := Low_Elem - 1; Low_Bogus : constant Integer := Low_Elem - 1;
High_Bogus : constant Integer := High_Elem + 1; High_Bogus : constant Integer := High_Elem + 1;
S : Instance := Create (Init_Size); S : Membership_Set := Create (Init_Size);
begin begin
Populate (S, Low_Elem, High_Elem); Populate (S, Low_Elem, High_Elem);
...@@ -269,7 +279,7 @@ procedure Sets1 is ...@@ -269,7 +279,7 @@ procedure Sets1 is
Count : Natural; Count : Natural;
Flag : Boolean; Flag : Boolean;
Iter : Iterator; Iter : Iterator;
S : Instance; S : Membership_Set;
begin begin
-- Ensure that every routine defined in the API fails on a set which -- Ensure that every routine defined in the API fails on a set which
...@@ -346,7 +356,7 @@ procedure Sets1 is ...@@ -346,7 +356,7 @@ procedure Sets1 is
Init_Size : Positive) Init_Size : Positive)
is is
Iter : Iterator; Iter : Iterator;
S : Instance := Create (Init_Size); S : Membership_Set := Create (Init_Size);
begin begin
Populate (S, Low_Elem, High_Elem); Populate (S, Low_Elem, High_Elem);
...@@ -391,7 +401,7 @@ procedure Sets1 is ...@@ -391,7 +401,7 @@ procedure Sets1 is
------------------- -------------------
procedure Test_Is_Empty is procedure Test_Is_Empty is
S : Instance := Create (8); S : Membership_Set := Create (8);
begin begin
if not Is_Empty (S) then if not Is_Empty (S) then
...@@ -421,7 +431,7 @@ procedure Sets1 is ...@@ -421,7 +431,7 @@ procedure Sets1 is
Elem : Integer; Elem : Integer;
Iter_1 : Iterator; Iter_1 : Iterator;
Iter_2 : Iterator; Iter_2 : Iterator;
S : Instance := Create (5); S : Membership_Set := Create (5);
begin begin
Populate (S, 1, 5); Populate (S, 1, 5);
...@@ -482,7 +492,7 @@ procedure Sets1 is ...@@ -482,7 +492,7 @@ procedure Sets1 is
procedure Test_Iterate_Empty is procedure Test_Iterate_Empty is
Elem : Integer; Elem : Integer;
Iter : Iterator; Iter : Iterator;
S : Instance := Create (5); S : Membership_Set := Create (5);
begin begin
-- Obtain an iterator. This action must lock all mutation operations of -- Obtain an iterator. This action must lock all mutation operations of
...@@ -526,7 +536,7 @@ procedure Sets1 is ...@@ -526,7 +536,7 @@ procedure Sets1 is
is is
Elem : Integer; Elem : Integer;
Iter : Iterator; Iter : Iterator;
S : Instance := Create (Init_Size); S : Membership_Set := Create (Init_Size);
begin begin
Populate (S, Low_Elem, High_Elem); Populate (S, Low_Elem, High_Elem);
...@@ -573,7 +583,7 @@ procedure Sets1 is ...@@ -573,7 +583,7 @@ procedure Sets1 is
--------------- ---------------
procedure Test_Size is procedure Test_Size is
S : Instance := Create (6); S : Membership_Set := Create (6);
Siz : Natural; Siz : Natural;
begin begin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment