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>
* 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
Instance in various routines.
* libgnat/g-lists.ads: Change type Instance to
......
gcc/ada/libgnat/g-sets.adb
......@@ -31,37 +31,40 @@
package body GNAT.Sets is
--------------------
-- Membership_Set --
--------------------
---------------------
-- Membership_Sets --
---------------------
package body Membership_Set is
package body Membership_Sets is
--------------
-- Contains --
--------------
function Contains (S : Instance; Elem : Element_Type) return Boolean is
function Contains
(S : Membership_Set;
Elem : Element_Type) return Boolean
is
begin
return Hashed_Set.Get (Hashed_Set.Instance (S), Elem);
return Hashed_Set.Get (Hashed_Set.Dynamic_Hash_Table (S), Elem);
end Contains;
------------
-- Create --
------------
function Create (Initial_Size : Positive) return Instance is
function Create (Initial_Size : Positive) return Membership_Set is
begin
return Instance (Hashed_Set.Create (Initial_Size));
return Membership_Set (Hashed_Set.Create (Initial_Size));
end Create;
------------
-- Delete --
------------
procedure Delete (S : Instance; Elem : Element_Type) is
procedure Delete (S : Membership_Set; Elem : Element_Type) is
begin
Hashed_Set.Delete (Hashed_Set.Instance (S), Elem);
Hashed_Set.Delete (Hashed_Set.Dynamic_Hash_Table (S), Elem);
end Delete;
-------------
......@@ -78,9 +81,9 @@ package body GNAT.Sets is
-- Destroy --
-------------
procedure Destroy (S : in out Instance) is
procedure Destroy (S : in out Membership_Set) is
begin
Hashed_Set.Destroy (Hashed_Set.Instance (S));
Hashed_Set.Destroy (Hashed_Set.Dynamic_Hash_Table (S));
end Destroy;
--------------
......@@ -96,34 +99,41 @@ package body GNAT.Sets is
-- Insert --
------------
procedure Insert (S : Instance; Elem : Element_Type) is
procedure Insert
(S : Membership_Set;
Elem : Element_Type)
is
begin
Hashed_Set.Put (Hashed_Set.Instance (S), Elem, True);
Hashed_Set.Put (Hashed_Set.Dynamic_Hash_Table (S), Elem, True);
end Insert;
--------------
-- Is_Empty --
--------------
function Is_Empty (S : Instance) return Boolean is
function Is_Empty (S : Membership_Set) return Boolean is
begin
return Hashed_Set.Is_Empty (Hashed_Set.Instance (S));
return Hashed_Set.Is_Empty (Hashed_Set.Dynamic_Hash_Table (S));
end Is_Empty;
-------------
-- Iterate --
-------------
function Iterate (S : Instance) return Iterator is
function Iterate (S : Membership_Set) return Iterator is
begin
return Iterator (Hashed_Set.Iterate (Hashed_Set.Instance (S)));
return
Iterator (Hashed_Set.Iterate (Hashed_Set.Dynamic_Hash_Table (S)));
end Iterate;
----------
-- Next --
----------
procedure Next (Iter : in out Iterator; Elem : out Element_Type) is
procedure Next
(Iter : in out Iterator;
Elem : out Element_Type)
is
begin
Hashed_Set.Next (Hashed_Set.Iterator (Iter), Elem);
end Next;
......@@ -132,28 +142,28 @@ package body GNAT.Sets is
-- Present --
-------------
function Present (S : Instance) return Boolean is
function Present (S : Membership_Set) return Boolean is
begin
return Hashed_Set.Present (Hashed_Set.Instance (S));
return Hashed_Set.Present (Hashed_Set.Dynamic_Hash_Table (S));
end Present;
-----------
-- Reset --
-----------
procedure Reset (S : Instance) is
procedure Reset (S : Membership_Set) is
begin
Hashed_Set.Reset (Hashed_Set.Instance (S));
Hashed_Set.Reset (Hashed_Set.Dynamic_Hash_Table (S));
end Reset;
----------
-- Size --
----------
function Size (S : Instance) return Natural is
function Size (S : Membership_Set) return Natural is
begin
return Hashed_Set.Size (Hashed_Set.Instance (S));
return Hashed_Set.Size (Hashed_Set.Dynamic_Hash_Table (S));
end Size;
end Membership_Set;
end Membership_Sets;
end GNAT.Sets;
gcc/ada/libgnat/g-sets.ads
......@@ -47,7 +47,7 @@ package GNAT.Sets is
--
-- The following use pattern must be employed with this set:
--
-- Set : Instance := Create (<some size>);
-- Set : Membership_Set := Create (<some size>);
--
-- <various operations>
--
......@@ -65,7 +65,7 @@ package GNAT.Sets is
with function Hash (Key : Element_Type) return Bucket_Range_Type;
-- Map an arbitrary key into the range of buckets
package Membership_Set is
package Membership_Sets is
--------------------
-- Set operations --
......@@ -74,44 +74,50 @@ package GNAT.Sets is
-- The following type denotes a membership set handle. Each instance
-- must be created using routine Create.
type Instance is private;
Nil : constant Instance;
type Membership_Set is private;
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
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
-- 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
-- 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);
procedure Destroy (S : in out Membership_Set);
-- 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);
procedure Insert
(S : Membership_Set;
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;
function Is_Empty (S : Membership_Set) return Boolean;
-- Determine whether set S is empty
function Present (S : Instance) return Boolean;
function Present (S : Membership_Set) return Boolean;
-- 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
-- created state. This action will raise Iterated if the membership set
-- 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
-------------------------
......@@ -132,7 +138,7 @@ package GNAT.Sets is
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
-- locks all mutation functionality of the associated membership set.
......@@ -152,7 +158,7 @@ package GNAT.Sets is
procedure Destroy (B : in out Boolean);
-- Destroy boolean B
package Hashed_Set is new Dynamic_HTable
package Hashed_Set is new Dynamic_Hash_Tables
(Key_Type => Element_Type,
Value_Type => Boolean,
No_Value => False,
......@@ -164,10 +170,10 @@ package GNAT.Sets is
Destroy_Value => Destroy,
Hash => Hash);
type Instance is new Hashed_Set.Instance;
Nil : constant Instance := Instance (Hashed_Set.Nil);
type Membership_Set is new Hashed_Set.Dynamic_Hash_Table;
Nil : constant Membership_Set := Membership_Set (Hashed_Set.Nil);
type Iterator is new Hashed_Set.Iterator;
end Membership_Set;
end Membership_Sets;
end GNAT.Sets;
gcc/testsuite/ChangeLog
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.
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
......
gcc/testsuite/gnat.dg/sets1.adb
......@@ -7,7 +7,7 @@ with GNAT.Sets; use GNAT.Sets;
procedure Sets1 is
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,
"=" => "=",
Hash => Hash);
......@@ -15,28 +15,32 @@ procedure Sets1 is
procedure Check_Empty
(Caller : String;
S : Instance;
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 Instance);
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 : Instance;
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 Instance);
procedure Check_Unlocked_Mutations
(Caller : String;
S : in out Membership_Set);
-- Ensure that all mutation operations of set S are unlocked
procedure Populate
(S : Instance;
(S : Membership_Set;
Low_Elem : Integer;
High_Elem : Integer);
-- Add elements in the range Low_Elem .. High_Elem in set S
......@@ -86,7 +90,7 @@ procedure Sets1 is
procedure Check_Empty
(Caller : String;
S : Instance;
S : Membership_Set;
Low_Elem : Integer;
High_Elem : Integer)
is
......@@ -110,7 +114,10 @@ procedure Sets1 is
-- 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
Delete (S, 1);
......@@ -149,7 +156,7 @@ procedure Sets1 is
procedure Check_Present
(Caller : String;
S : Instance;
S : Membership_Set;
Low_Elem : Integer;
High_Elem : Integer)
is
......@@ -189,7 +196,10 @@ procedure Sets1 is
-- 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
Delete (S, 1);
Insert (S, 1);
......@@ -209,7 +219,7 @@ procedure Sets1 is
--------------
procedure Populate
(S : Instance;
(S : Membership_Set;
Low_Elem : Integer;
High_Elem : Integer)
is
......@@ -231,7 +241,7 @@ procedure Sets1 is
Low_Bogus : constant Integer := Low_Elem - 1;
High_Bogus : constant Integer := High_Elem + 1;
S : Instance := Create (Init_Size);
S : Membership_Set := Create (Init_Size);
begin
Populate (S, Low_Elem, High_Elem);
......@@ -269,7 +279,7 @@ procedure Sets1 is
Count : Natural;
Flag : Boolean;
Iter : Iterator;
S : Instance;
S : Membership_Set;
begin
-- Ensure that every routine defined in the API fails on a set which
......@@ -346,7 +356,7 @@ procedure Sets1 is
Init_Size : Positive)
is
Iter : Iterator;
S : Instance := Create (Init_Size);
S : Membership_Set := Create (Init_Size);
begin
Populate (S, Low_Elem, High_Elem);
......@@ -391,7 +401,7 @@ procedure Sets1 is
-------------------
procedure Test_Is_Empty is
S : Instance := Create (8);
S : Membership_Set := Create (8);
begin
if not Is_Empty (S) then
......@@ -421,7 +431,7 @@ procedure Sets1 is
Elem : Integer;
Iter_1 : Iterator;
Iter_2 : Iterator;
S : Instance := Create (5);
S : Membership_Set := Create (5);
begin
Populate (S, 1, 5);
......@@ -482,7 +492,7 @@ procedure Sets1 is
procedure Test_Iterate_Empty is
Elem : Integer;
Iter : Iterator;
S : Instance := Create (5);
S : Membership_Set := Create (5);
begin
-- Obtain an iterator. This action must lock all mutation operations of
......@@ -526,7 +536,7 @@ procedure Sets1 is
is
Elem : Integer;
Iter : Iterator;
S : Instance := Create (Init_Size);
S : Membership_Set := Create (Init_Size);
begin
Populate (S, Low_Elem, High_Elem);
......@@ -573,7 +583,7 @@ procedure Sets1 is
---------------
procedure Test_Size is
S : Instance := Create (6);
S : Membership_Set := Create (6);
Siz : Natural;
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