------------
-- 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