aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHristian Kirtchev <kirtchev@adacore.com>2019-07-01 13:34:55 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-01 13:34:55 +0000
commit7f070fc469c71b0d3e435cf23964b6de7cd9943e (patch)
tree8bd656f2847fec5157f09040944b427b132db2ce
parent68f27c97bff2d21c107ca90e1b597fed45b52ba5 (diff)
downloadgcc-7f070fc469c71b0d3e435cf23964b6de7cd9943e.zip
gcc-7f070fc469c71b0d3e435cf23964b6de7cd9943e.tar.gz
gcc-7f070fc469c71b0d3e435cf23964b6de7cd9943e.tar.bz2
[Ada] Clean up of GNAT.Dynamic_HTables
------------ -- Source -- ------------ -- operations.adb with Ada.Text_IO; use Ada.Text_IO; with GNAT; use GNAT; with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables; procedure Operations is procedure Destroy (Val : in out Integer) is null; function Hash (Key : Integer) return Bucket_Range_Type; package DHT is new Dynamic_Hash_Tables (Key_Type => Integer, Value_Type => Integer, No_Value => 0, Expansion_Threshold => 1.3, Expansion_Factor => 2, Compression_Threshold => 0.3, Compression_Factor => 2, "=" => "=", Destroy_Value => Destroy, Hash => Hash); use DHT; function Create_And_Populate (Low_Key : Integer; High_Key : Integer; Init_Size : Positive) return Dynamic_Hash_Table; -- 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. procedure Check_Empty (Caller : String; T : Dynamic_Hash_Table; Low_Key : Integer; High_Key : Integer); -- Ensure that -- -- * The key-value pairs count of hash table T is 0. -- * All values for the keys in range Low_Key .. High_Key are 0. procedure Check_Keys (Caller : String; Iter : in out Iterator; Low_Key : Integer; High_Key : Integer); -- Ensure that iterator Iter visits every key in the range Low_Key .. -- High_Key exactly once. procedure Check_Locked_Mutations (Caller : String; T : in out Dynamic_Hash_Table); -- Ensure that all mutation operations of hash table T are locked procedure Check_Size (Caller : String; T : Dynamic_Hash_Table; 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 : 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 : Natural; Init_Size : Positive); -- Verify that -- -- * Put properly inserts values in the hash table. -- * Get properly retrieves all values inserted in the table. -- * Delete properly deletes values. -- * The size of the hash table properly reflects the number of key-value -- pairs. -- -- Low_Key and High_Key denote the range of keys to be inserted, retrieved, -- and deleted. Exp_Count is the expected count of key-value pairs n the -- hash table. Init_Size denotes the initial size of the table. procedure Test_Iterate (Low_Key : Integer; High_Key : Integer; Init_Size : Positive); -- Verify that iterators -- -- * Properly visit each key exactly once. -- * Mutation operations are properly locked and unlocked during -- iteration. -- -- 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 : Positive); -- Verify that an iterator over an empty hash table -- -- * Does not visit any key -- * Mutation operations are properly locked and unlocked during -- iteration. -- -- Init_Size denotes the initial size of the table. procedure Test_Iterate_Forced (Low_Key : Integer; High_Key : Integer; Init_Size : Positive); -- Verify that an iterator that is forcefully advanced by just Next -- -- * Properly visit each key exactly once. -- * Mutation operations are properly locked and unlocked during -- iteration. -- -- 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_Replace (Low_Val : Integer; High_Val : Integer; 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. procedure Test_Reset (Low_Key : Integer; High_Key : Integer; 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. ------------------------- -- Create_And_Populate -- ------------------------- function Create_And_Populate (Low_Key : Integer; High_Key : Integer; Init_Size : Positive) return Dynamic_Hash_Table is T : Dynamic_Hash_Table; begin T := Create (Init_Size); for Key in Low_Key .. High_Key loop Put (T, Key, Key); end loop; return T; end Create_And_Populate; ----------------- -- Check_Empty -- ----------------- procedure Check_Empty (Caller : String; T : Dynamic_Hash_Table; Low_Key : Integer; High_Key : Integer) is Val : Integer; begin Check_Size (Caller => Caller, T => T, Exp_Count => 0); for Key in Low_Key .. High_Key loop Val := Get (T, Key); if Val /= 0 then Put_Line ("ERROR: " & Caller & ": wrong value"); Put_Line ("expected: 0"); Put_Line ("got :" & Val'Img); end if; end loop; end Check_Empty; ---------------- -- Check_Keys -- ---------------- procedure Check_Keys (Caller : String; Iter : in out Iterator; Low_Key : Integer; High_Key : Integer) is type Bit_Vector is array (Low_Key .. High_Key) of Boolean; pragma Pack (Bit_Vector); Count : Natural; Key : Integer; Seen : Bit_Vector := (others => False); begin -- Compute the number of outstanding keys that have to be iterated on Count := High_Key - Low_Key + 1; while Has_Next (Iter) loop Next (Iter, Key); if Seen (Key) then Put_Line ("ERROR: " & Caller & ": Check_Keys: duplicate key" & Key'Img); else Seen (Key) := True; Count := Count - 1; end if; end loop; -- In the end, all keys must have been iterated on if Count /= 0 then for Key in Seen'Range loop if not Seen (Key) then Put_Line ("ERROR: " & Caller & ": Check_Keys: missing key" & Key'Img); end if; end loop; end if; end Check_Keys; ---------------------------- -- Check_Locked_Mutations -- ---------------------------- procedure Check_Locked_Mutations (Caller : String; T : in out Dynamic_Hash_Table) is begin begin Delete (T, 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 (T); Put_Line ("ERROR: " & Caller & ": Destroy: no exception raised"); exception when Iterated => null; when others => Put_Line ("ERROR: " & Caller & ": Destroy: unexpected exception"); end; begin Put (T, 1, 1); Put_Line ("ERROR: " & Caller & ": Put: no exception raised"); exception when Iterated => null; when others => Put_Line ("ERROR: " & Caller & ": Put: unexpected exception"); end; begin Reset (T); Put_Line ("ERROR: " & Caller & ": Reset: no exception raised"); exception when Iterated => null; when others => Put_Line ("ERROR: " & Caller & ": Reset: unexpected exception"); end; end Check_Locked_Mutations; ---------------- -- Check_Size -- ---------------- procedure Check_Size (Caller : String; T : Dynamic_Hash_Table; Exp_Count : Natural) is Count : constant Natural := Size (T); begin if Count /= Exp_Count then Put_Line ("ERROR: " & Caller & ": Size: wrong value"); Put_Line ("expected:" & Exp_Count'Img); Put_Line ("got :" & Count'Img); end if; end Check_Size; ---------- -- Hash -- ---------- function Hash (Key : Integer) return Bucket_Range_Type is begin return Bucket_Range_Type (Key); end Hash; ----------------- -- Test_Create -- ----------------- procedure Test_Create (Init_Size : Positive) is Count : Natural; Iter : Iterator; T : Dynamic_Hash_Table; Val : Integer; begin -- Ensure that every routine defined in the API fails on a hash table -- which has not been created yet. begin Delete (T, 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 Destroy (T); Put_Line ("ERROR: Test_Create: Destroy: no exception raised"); exception when Not_Created => null; when others => Put_Line ("ERROR: Test_Create: Destroy: unexpected exception"); end; begin Val := Get (T, 1); Put_Line ("ERROR: Test_Create: Get: no exception raised"); exception when Not_Created => null; when others => Put_Line ("ERROR: Test_Create: Get: unexpected exception"); end; begin Iter := Iterate (T); 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 Put (T, 1, 1); Put_Line ("ERROR: Test_Create: Put: no exception raised"); exception when Not_Created => null; when others => Put_Line ("ERROR: Test_Create: Put: unexpected exception"); end; begin Reset (T); Put_Line ("ERROR: Test_Create: Reset: no exception raised"); exception when Not_Created => null; when others => Put_Line ("ERROR: Test_Create: Reset: unexpected exception"); end; begin Count := Size (T); 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; -- Test create T := Create (Init_Size); -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Create; ------------------------------ -- Test_Delete_Get_Put_Size -- ------------------------------ procedure Test_Delete_Get_Put_Size (Low_Key : Integer; High_Key : Integer; Exp_Count : Natural; Init_Size : Positive) is Exp_Val : Integer; T : Dynamic_Hash_Table; Val : Integer; begin T := Create_And_Populate (Low_Key, High_Key, Init_Size); -- Ensure that its size matches an expected value Check_Size (Caller => "Test_Delete_Get_Put_Size", T => T, Exp_Count => Exp_Count); -- Ensure that every value for the range of keys exists for Key in Low_Key .. High_Key loop Val := Get (T, Key); if Val /= Key then Put_Line ("ERROR: Test_Delete_Get_Put_Size: Get: wrong value"); Put_Line ("expected:" & Key'Img); Put_Line ("got :" & Val'Img); end if; end loop; -- Delete values whose keys are divisible by 10 for Key in Low_Key .. High_Key loop if Key mod 10 = 0 then Delete (T, Key); end if; end loop; -- Ensure that all values whose keys were not deleted still exist for Key in Low_Key .. High_Key loop if Key mod 10 = 0 then Exp_Val := 0; else Exp_Val := Key; end if; Val := Get (T, Key); if Val /= Exp_Val then Put_Line ("ERROR: Test_Delete_Get_Put_Size: Get: wrong value"); Put_Line ("expected:" & Exp_Val'Img); Put_Line ("got :" & Val'Img); end if; end loop; -- Delete all values for Key in Low_Key .. High_Key loop Delete (T, Key); end loop; -- Ensure that the hash table is empty Check_Empty (Caller => "Test_Delete_Get_Put_Size", T => T, Low_Key => Low_Key, High_Key => High_Key); -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Delete_Get_Put_Size; ------------------ -- Test_Iterate -- ------------------ procedure Test_Iterate (Low_Key : Integer; High_Key : Integer; Init_Size : Positive) is Iter_1 : Iterator; Iter_2 : Iterator; T : Dynamic_Hash_Table; begin T := Create_And_Populate (Low_Key, High_Key, Init_Size); -- Obtain an iterator. This action must lock all mutation operations of -- the hash table. Iter_1 := Iterate (T); -- Ensure that every mutation routine defined in the API fails on a hash -- table with at least one outstanding iterator. Check_Locked_Mutations (Caller => "Test_Iterate", T => T); -- Obtain another iterator Iter_2 := Iterate (T); -- Ensure that every mutation is still locked Check_Locked_Mutations (Caller => "Test_Iterate", T => T); -- Ensure that all keys are iterable. Note that this does not unlock the -- mutation operations of the hash table because Iter_2 is not exhausted -- yet. Check_Keys (Caller => "Test_Iterate", Iter => Iter_1, Low_Key => Low_Key, High_Key => High_Key); Check_Locked_Mutations (Caller => "Test_Iterate", T => T); -- Ensure that all keys are iterable. This action unlocks all mutation -- operations of the hash table because all outstanding iterators have -- been exhausted. Check_Keys (Caller => "Test_Iterate", Iter => Iter_2, Low_Key => Low_Key, High_Key => High_Key); -- Ensure that all mutation operations are once again callable Delete (T, Low_Key); Put (T, Low_Key, Low_Key); Reset (T); -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Iterate; ------------------------ -- Test_Iterate_Empty -- ------------------------ procedure Test_Iterate_Empty (Init_Size : Positive) is Iter : Iterator; Key : Integer; T : Dynamic_Hash_Table; begin T := Create_And_Populate (0, -1, Init_Size); -- Obtain an iterator. This action must lock all mutation operations of -- the hash table. Iter := Iterate (T); -- Ensure that every mutation routine defined in the API fails on a hash -- table with at least one outstanding iterator. Check_Locked_Mutations (Caller => "Test_Iterate_Empty", T => T); -- Attempt to iterate over the keys while Has_Next (Iter) loop Next (Iter, Key); Put_Line ("ERROR: Test_Iterate_Empty: key" & Key'Img & " exists"); end loop; -- Ensure that all mutation operations are once again callable Delete (T, 1); Put (T, 1, 1); Reset (T); -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Iterate_Empty; ------------------------- -- Test_Iterate_Forced -- ------------------------- procedure Test_Iterate_Forced (Low_Key : Integer; High_Key : Integer; Init_Size : Positive) is Iter : Iterator; Key : Integer; T : Dynamic_Hash_Table; begin T := Create_And_Populate (Low_Key, High_Key, Init_Size); -- Obtain an iterator. This action must lock all mutation operations of -- the hash table. Iter := Iterate (T); -- Ensure that every mutation routine defined in the API fails on a hash -- table with at least one outstanding iterator. Check_Locked_Mutations (Caller => "Test_Iterate_Forced", T => T); -- Forcibly advance the iterator until it raises an exception begin for Guard in Low_Key .. High_Key + 1 loop Next (Iter, Key); 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 Delete (T, Low_Key); Put (T, Low_Key, Low_Key); Reset (T); -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Iterate_Forced; ------------------ -- Test_Replace -- ------------------ procedure Test_Replace (Low_Val : Integer; High_Val : Integer; Init_Size : Positive) is Key : constant Integer := 1; T : Dynamic_Hash_Table; Val : Integer; begin T := Create (Init_Size); -- Ensure the Put properly updates values with the same key for Exp_Val in Low_Val .. High_Val loop Put (T, Key, Exp_Val); Val := Get (T, Key); if Val /= Exp_Val then Put_Line ("ERROR: Test_Replace: Get: wrong value"); Put_Line ("expected:" & Exp_Val'Img); Put_Line ("got :" & Val'Img); end if; end loop; -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Replace; ---------------- -- Test_Reset -- ---------------- procedure Test_Reset (Low_Key : Integer; High_Key : Integer; Init_Size : Positive) is T : Dynamic_Hash_Table; begin T := Create_And_Populate (Low_Key, High_Key, Init_Size); -- Reset the contents of the hash table Reset (T); -- Ensure that the hash table is empty Check_Empty (Caller => "Test_Reset", T => T, Low_Key => Low_Key, High_Key => High_Key); -- Clean up the hash table to prevent memory leaks Destroy (T); end Test_Reset; -- Start of processing for Operations begin Test_Create (Init_Size => 1); Test_Create (Init_Size => 100); Test_Delete_Get_Put_Size (Low_Key => 1, High_Key => 1, Exp_Count => 1, Init_Size => 1); Test_Delete_Get_Put_Size (Low_Key => 1, High_Key => 1000, Exp_Count => 1000, Init_Size => 32); Test_Iterate (Low_Key => 1, High_Key => 32, Init_Size => 32); Test_Iterate_Empty (Init_Size => 32); Test_Iterate_Forced (Low_Key => 1, High_Key => 32, Init_Size => 32); Test_Replace (Low_Val => 1, High_Val => 10, Init_Size => 32); Test_Reset (Low_Key => 1, High_Key => 1000, Init_Size => 100); 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-dynhta.adb: Use type Dynamic_Hash_Table rather than Instance in various routines. * libgnat/g-dynhta.ads: Change type Instance to Dynamic_Hash_Table. Update various routines that mention the type. gcc/testsuite/ * gnat.dg/dynhash.adb, gnat.dg/dynhash1.adb: Update. From-SVN: r272860
-rw-r--r--gcc/ada/ChangeLog8
-rw-r--r--gcc/ada/libgnat/g-dynhta.adb93
-rw-r--r--gcc/ada/libgnat/g-dynhta.ads51
-rw-r--r--gcc/testsuite/ChangeLog4
-rw-r--r--gcc/testsuite/gnat.dg/dynhash.adb41
-rw-r--r--gcc/testsuite/gnat.dg/dynhash1.adb8
6 files changed, 128 insertions, 77 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 95b52b6..c527b80 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,13 @@
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
+ * libgnat/g-dynhta.adb: Use type Dynamic_Hash_Table rather than
+ Instance in various routines.
+ * libgnat/g-dynhta.ads: Change type Instance to
+ Dynamic_Hash_Table. Update various routines that mention the
+ type.
+
+2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
+
* exp_attr.adb, exp_ch7.adb, exp_unst.adb, sem_ch3.adb,
sem_util.adb, uintp.adb, uintp.ads: Minor reformatting.
diff --git a/gcc/ada/libgnat/g-dynhta.adb b/gcc/ada/libgnat/g-dynhta.adb
index 31b77de..6cb4182 100644
--- a/gcc/ada/libgnat/g-dynhta.adb
+++ b/gcc/ada/libgnat/g-dynhta.adb
@@ -364,11 +364,11 @@ package body GNAT.Dynamic_HTables is
end Set_Next;
end Simple_HTable;
- --------------------
- -- Dynamic_HTable --
- --------------------
+ -------------------------
+ -- Dynamic_Hash_Tables --
+ -------------------------
- package body Dynamic_HTable is
+ package body Dynamic_Hash_Tables is
Minimum_Size : constant Bucket_Range_Type := 8;
-- Minimum size of the buckets
@@ -382,7 +382,9 @@ package body GNAT.Dynamic_HTables is
-- Maximum safe size for hash table expansion. Beyond this size, an
-- expansion will overflow the buckets.
- procedure Delete_Node (T : Instance; Nod : Node_Ptr);
+ procedure Delete_Node
+ (T : Dynamic_Hash_Table;
+ Nod : Node_Ptr);
pragma Inline (Delete_Node);
-- Detach and delete node Nod from table T
@@ -398,12 +400,12 @@ package body GNAT.Dynamic_HTables is
pragma Inline (Ensure_Circular);
-- Ensure that dummy head Head is circular with respect to itself
- procedure Ensure_Created (T : Instance);
+ procedure Ensure_Created (T : Dynamic_Hash_Table);
pragma Inline (Ensure_Created);
-- Verify that hash table T is created. Raise Not_Created if this is not
-- the case.
- procedure Ensure_Unlocked (T : Instance);
+ procedure Ensure_Unlocked (T : Dynamic_Hash_Table);
pragma Inline (Ensure_Unlocked);
-- Verify that hash table T is unlocked. Raise Iterated if this is not
-- the case.
@@ -422,7 +424,7 @@ package body GNAT.Dynamic_HTables is
-- otherwise return null.
procedure First_Valid_Node
- (T : Instance;
+ (T : Dynamic_Hash_Table;
Low_Bkt : Bucket_Range_Type;
High_Bkt : Bucket_Range_Type;
Idx : out Bucket_Range_Type;
@@ -437,7 +439,8 @@ package body GNAT.Dynamic_HTables is
new Ada.Unchecked_Deallocation (Bucket_Table, Bucket_Table_Ptr);
procedure Free is
- new Ada.Unchecked_Deallocation (Hash_Table, Instance);
+ new Ada.Unchecked_Deallocation
+ (Dynamic_Hash_Table_Attributes, Dynamic_Hash_Table);
procedure Free is
new Ada.Unchecked_Deallocation (Node, Node_Ptr);
@@ -451,15 +454,17 @@ package body GNAT.Dynamic_HTables is
-- Determine whether node Nod is non-null and does not refer to dummy
-- head Head, thus making it valid.
- function Load_Factor (T : Instance) return Threshold_Type;
+ function Load_Factor (T : Dynamic_Hash_Table) return Threshold_Type;
pragma Inline (Load_Factor);
-- Calculate the load factor of hash table T
- procedure Lock (T : Instance);
+ procedure Lock (T : Dynamic_Hash_Table);
pragma Inline (Lock);
-- Lock all mutation functionality of hash table T
- procedure Mutate_And_Rehash (T : Instance; Size : Bucket_Range_Type);
+ procedure Mutate_And_Rehash
+ (T : Dynamic_Hash_Table;
+ Size : Bucket_Range_Type);
pragma Inline (Mutate_And_Rehash);
-- Replace the buckets of hash table T with a new set of buckets of size
-- Size. Rehash all key-value pairs from the old to the new buckets.
@@ -476,7 +481,7 @@ package body GNAT.Dynamic_HTables is
pragma Inline (Present);
-- Determine whether node Nod exists
- procedure Unlock (T : Instance);
+ procedure Unlock (T : Dynamic_Hash_Table);
pragma Inline (Unlock);
-- Unlock all mutation functionality of hash table T
@@ -484,13 +489,13 @@ package body GNAT.Dynamic_HTables is
-- Create --
------------
- function Create (Initial_Size : Positive) return Instance is
+ function Create (Initial_Size : Positive) return Dynamic_Hash_Table is
Size : constant Bucket_Range_Type :=
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;
+ T : constant Dynamic_Hash_Table := new Dynamic_Hash_Table_Attributes;
begin
T.Buckets := new Bucket_Table (0 .. Size - 1);
@@ -503,7 +508,10 @@ package body GNAT.Dynamic_HTables is
-- Delete --
------------
- procedure Delete (T : Instance; Key : Key_Type) is
+ procedure Delete
+ (T : Dynamic_Hash_Table;
+ Key : Key_Type)
+ is
Head : Node_Ptr;
Nod : Node_Ptr;
@@ -531,7 +539,10 @@ package body GNAT.Dynamic_HTables is
-- Delete_Node --
-----------------
- procedure Delete_Node (T : Instance; Nod : Node_Ptr) is
+ procedure Delete_Node
+ (T : Dynamic_Hash_Table;
+ Nod : Node_Ptr)
+ is
procedure Compress;
pragma Inline (Compress);
-- Determine whether hash table T requires compression, and if so,
@@ -586,7 +597,7 @@ package body GNAT.Dynamic_HTables is
-- Destroy --
-------------
- procedure Destroy (T : in out Instance) is
+ procedure Destroy (T : in out Dynamic_Hash_Table) is
begin
Ensure_Created (T);
Ensure_Unlocked (T);
@@ -678,7 +689,7 @@ package body GNAT.Dynamic_HTables is
-- Ensure_Created --
--------------------
- procedure Ensure_Created (T : Instance) is
+ procedure Ensure_Created (T : Dynamic_Hash_Table) is
begin
if not Present (T) then
raise Not_Created;
@@ -689,7 +700,7 @@ package body GNAT.Dynamic_HTables is
-- Ensure_Unlocked --
---------------------
- procedure Ensure_Unlocked (T : Instance) is
+ procedure Ensure_Unlocked (T : Dynamic_Hash_Table) is
begin
pragma Assert (Present (T));
@@ -746,7 +757,7 @@ package body GNAT.Dynamic_HTables is
----------------------
procedure First_Valid_Node
- (T : Instance;
+ (T : Dynamic_Hash_Table;
Low_Bkt : Bucket_Range_Type;
High_Bkt : Bucket_Range_Type;
Idx : out Bucket_Range_Type;
@@ -784,7 +795,10 @@ package body GNAT.Dynamic_HTables is
-- Get --
---------
- function Get (T : Instance; Key : Key_Type) return Value_Type is
+ function Get
+ (T : Dynamic_Hash_Table;
+ Key : Key_Type) return Value_Type
+ is
Head : Node_Ptr;
Nod : Node_Ptr;
@@ -814,8 +828,8 @@ package body GNAT.Dynamic_HTables is
--------------
function Has_Next (Iter : Iterator) return Boolean is
- Is_OK : constant Boolean := Is_Valid (Iter);
- T : constant Instance := Iter.Table;
+ Is_OK : constant Boolean := Is_Valid (Iter);
+ T : constant Dynamic_Hash_Table := Iter.Table;
begin
pragma Assert (Present (T));
@@ -835,7 +849,7 @@ package body GNAT.Dynamic_HTables is
-- Is_Empty --
--------------
- function Is_Empty (T : Instance) return Boolean is
+ function Is_Empty (T : Dynamic_Hash_Table) return Boolean is
begin
Ensure_Created (T);
@@ -870,7 +884,7 @@ package body GNAT.Dynamic_HTables is
-- Iterate --
-------------
- function Iterate (T : Instance) return Iterator is
+ function Iterate (T : Dynamic_Hash_Table) return Iterator is
Iter : Iterator;
begin
@@ -906,7 +920,7 @@ package body GNAT.Dynamic_HTables is
-- Load_Factor --
-----------------
- function Load_Factor (T : Instance) return Threshold_Type is
+ function Load_Factor (T : Dynamic_Hash_Table) return Threshold_Type is
pragma Assert (Present (T));
pragma Assert (Present (T.Buckets));
@@ -920,7 +934,7 @@ package body GNAT.Dynamic_HTables is
-- Lock --
----------
- procedure Lock (T : Instance) is
+ procedure Lock (T : Dynamic_Hash_Table) is
begin
-- The hash table may be locked multiple times if multiple iterators
-- are operating over it.
@@ -932,7 +946,10 @@ package body GNAT.Dynamic_HTables is
-- Mutate_And_Rehash --
-----------------------
- procedure Mutate_And_Rehash (T : Instance; Size : Bucket_Range_Type) is
+ procedure Mutate_And_Rehash
+ (T : Dynamic_Hash_Table;
+ Size : Bucket_Range_Type)
+ is
procedure Rehash (From : Bucket_Table_Ptr; To : Bucket_Table_Ptr);
pragma Inline (Rehash);
-- Remove all nodes from buckets From and rehash them into buckets To
@@ -1031,7 +1048,7 @@ package body GNAT.Dynamic_HTables is
procedure Next (Iter : in out Iterator; Key : out Key_Type) is
Is_OK : constant Boolean := Is_Valid (Iter);
Saved : constant Node_Ptr := Iter.Curr_Nod;
- T : constant Instance := Iter.Table;
+ T : constant Dynamic_Hash_Table := Iter.Table;
Head : Node_Ptr;
begin
@@ -1109,7 +1126,7 @@ package body GNAT.Dynamic_HTables is
-- Present --
-------------
- function Present (T : Instance) return Boolean is
+ function Present (T : Dynamic_Hash_Table) return Boolean is
begin
return T /= Nil;
end Present;
@@ -1118,7 +1135,11 @@ package body GNAT.Dynamic_HTables is
-- Put --
---------
- procedure Put (T : Instance; Key : Key_Type; Value : Value_Type) is
+ procedure Put
+ (T : Dynamic_Hash_Table;
+ Key : Key_Type;
+ Value : Value_Type)
+ is
procedure Expand;
pragma Inline (Expand);
-- Determine whether hash table T requires expansion, and if so,
@@ -1223,7 +1244,7 @@ package body GNAT.Dynamic_HTables is
-- Reset --
-----------
- procedure Reset (T : Instance) is
+ procedure Reset (T : Dynamic_Hash_Table) is
begin
Ensure_Created (T);
Ensure_Unlocked (T);
@@ -1243,7 +1264,7 @@ package body GNAT.Dynamic_HTables is
-- Size --
----------
- function Size (T : Instance) return Natural is
+ function Size (T : Dynamic_Hash_Table) return Natural is
begin
Ensure_Created (T);
@@ -1254,13 +1275,13 @@ package body GNAT.Dynamic_HTables is
-- Unlock --
------------
- procedure Unlock (T : Instance) is
+ procedure Unlock (T : Dynamic_Hash_Table) is
begin
-- The hash table may be locked multiple times if multiple iterators
-- are operating over it.
T.Iterators := T.Iterators - 1;
end Unlock;
- end Dynamic_HTable;
+ end Dynamic_Hash_Tables;
end GNAT.Dynamic_HTables;
diff --git a/gcc/ada/libgnat/g-dynhta.ads b/gcc/ada/libgnat/g-dynhta.ads
index 7b8d1d8..6c19f0f 100644
--- a/gcc/ada/libgnat/g-dynhta.ads
+++ b/gcc/ada/libgnat/g-dynhta.ads
@@ -258,9 +258,9 @@ package GNAT.Dynamic_HTables is
Nil : constant Instance := Instance (Tab.Nil);
end Simple_HTable;
- --------------------
- -- Dynamic_HTable --
- --------------------
+ -------------------------
+ -- Dynamic_Hash_Tables --
+ -------------------------
-- The following package offers a hash table abstraction with the following
-- characteristics:
@@ -275,7 +275,7 @@ package GNAT.Dynamic_HTables is
--
-- The following use pattern must be employed when operating this table:
--
- -- Table : Instance := Create (<some size>);
+ -- Table : Dynamic_Hash_Table := Create (<some size>);
--
-- <various operations>
--
@@ -333,7 +333,7 @@ package GNAT.Dynamic_HTables is
with function Hash (Key : Key_Type) return Bucket_Range_Type;
-- Map an arbitrary key into the range of buckets
- package Dynamic_HTable is
+ package Dynamic_Hash_Tables is
----------------------
-- Table operations --
@@ -342,37 +342,44 @@ package GNAT.Dynamic_HTables is
-- The following type denotes a hash table handle. Each instance must be
-- created using routine Create.
- type Instance is private;
- Nil : constant Instance;
+ type Dynamic_Hash_Table is private;
+ Nil : constant Dynamic_Hash_Table;
- function Create (Initial_Size : Positive) return Instance;
+ function Create (Initial_Size : Positive) return Dynamic_Hash_Table;
-- 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);
+ procedure Delete
+ (T : Dynamic_Hash_Table;
+ 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 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);
+ procedure Destroy (T : in out Dynamic_Hash_Table);
-- 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 Iterated if the hash table has outstanding
-- iterators.
- function Get (T : Instance; Key : Key_Type) return Value_Type;
+ function Get
+ (T : Dynamic_Hash_Table;
+ 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.
- function Is_Empty (T : Instance) return Boolean;
+ function Is_Empty (T : Dynamic_Hash_Table) return Boolean;
-- Determine whether hash table T is empty
- function Present (T : Instance) return Boolean;
+ function Present (T : Dynamic_Hash_Table) return Boolean;
-- Determine whether hash table T exists
- procedure Put (T : Instance; Key : Key_Type; Value : Value_Type);
+ procedure Put
+ (T : Dynamic_Hash_Table;
+ 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 Iterated if
@@ -380,12 +387,12 @@ package GNAT.Dynamic_HTables is
-- over Expansion_Threshold, the size of the buckets is increased by
-- Expansion_Factor.
- procedure Reset (T : Instance);
+ procedure Reset (T : Dynamic_Hash_Table);
-- Destroy the contents of hash table T, and reset it to its initial
-- created state. This action will raise Iterated if the hash table
-- has outstanding iterators.
- function Size (T : Instance) return Natural;
+ function Size (T : Dynamic_Hash_Table) return Natural;
-- Obtain the number of key-value pairs in hash table T
-------------------------
@@ -412,7 +419,7 @@ package GNAT.Dynamic_HTables is
-- iterator has been exhausted, restore all mutation functionality of
-- the associated hash table.
- function Iterate (T : Instance) return Iterator;
+ function Iterate (T : Dynamic_Hash_Table) return Iterator;
-- Obtain an iterator over the keys of hash table T. This action locks
-- all mutation functionality of the associated hash table.
@@ -461,7 +468,7 @@ package GNAT.Dynamic_HTables is
-- The following type represents a hash table
- type Hash_Table is record
+ type Dynamic_Hash_Table_Attributes is record
Buckets : Bucket_Table_Ptr := null;
-- Reference to the compressing / expanding buckets
@@ -475,8 +482,8 @@ package GNAT.Dynamic_HTables is
-- Number of key-value pairs in the buckets
end record;
- type Instance is access Hash_Table;
- Nil : constant Instance := null;
+ type Dynamic_Hash_Table is access Dynamic_Hash_Table_Attributes;
+ Nil : constant Dynamic_Hash_Table := null;
-- The following type represents a key iterator
@@ -491,9 +498,9 @@ package GNAT.Dynamic_HTables is
-- always point to a valid node. A value of null indicates that the
-- iterator is exhausted.
- Table : Instance := null;
+ Table : Dynamic_Hash_Table := null;
-- Reference to the associated hash table
end record;
- end Dynamic_HTable;
+ end Dynamic_Hash_Tables;
end GNAT.Dynamic_HTables;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a64cb52..edc2bd6 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,9 @@
2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
+ * gnat.dg/dynhash.adb, gnat.dg/dynhash1.adb: Update.
+
+2019-07-01 Hristian Kirtchev <kirtchev@adacore.com>
+
* gnat.dg/freezing1.adb, gnat.dg/freezing1.ads,
gnat.dg/freezing1_pack.adb, gnat.dg/freezing1_pack.ads: New
testcase.
diff --git a/gcc/testsuite/gnat.dg/dynhash.adb b/gcc/testsuite/gnat.dg/dynhash.adb
index c51e6e2..8b229c4 100644
--- a/gcc/testsuite/gnat.dg/dynhash.adb
+++ b/gcc/testsuite/gnat.dg/dynhash.adb
@@ -5,9 +5,10 @@ with GNAT; use GNAT;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
procedure Dynhash is
+ procedure Destroy (Val : in out Integer) is null;
function Hash (Key : Integer) return Bucket_Range_Type;
- package DHT is new Dynamic_HTable
+ package DHT is new Dynamic_Hash_Tables
(Key_Type => Integer,
Value_Type => Integer,
No_Value => 0,
@@ -16,20 +17,21 @@ procedure Dynhash is
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
+ Destroy_Value => Destroy,
Hash => Hash);
use DHT;
function Create_And_Populate
(Low_Key : Integer;
High_Key : Integer;
- Init_Size : Positive) return Instance;
+ Init_Size : Positive) return Dynamic_Hash_Table;
-- 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.
procedure Check_Empty
(Caller : String;
- T : Instance;
+ T : Dynamic_Hash_Table;
Low_Key : Integer;
High_Key : Integer);
-- Ensure that
@@ -45,12 +47,14 @@ procedure Dynhash is
-- Ensure that iterator Iter visits every key in the range Low_Key ..
-- High_Key exactly once.
- procedure Check_Locked_Mutations (Caller : String; T : in out Instance);
+ procedure Check_Locked_Mutations
+ (Caller : String;
+ T : in out Dynamic_Hash_Table);
-- Ensure that all mutation operations of hash table T are locked
procedure Check_Size
(Caller : String;
- T : Instance;
+ T : Dynamic_Hash_Table;
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.
@@ -134,9 +138,9 @@ procedure Dynhash is
function Create_And_Populate
(Low_Key : Integer;
High_Key : Integer;
- Init_Size : Positive) return Instance
+ Init_Size : Positive) return Dynamic_Hash_Table
is
- T : Instance;
+ T : Dynamic_Hash_Table;
begin
T := Create (Init_Size);
@@ -154,7 +158,7 @@ procedure Dynhash is
procedure Check_Empty
(Caller : String;
- T : Instance;
+ T : Dynamic_Hash_Table;
Low_Key : Integer;
High_Key : Integer)
is
@@ -227,7 +231,10 @@ procedure Dynhash is
-- Check_Locked_Mutations --
----------------------------
- procedure Check_Locked_Mutations (Caller : String; T : in out Instance) is
+ procedure Check_Locked_Mutations
+ (Caller : String;
+ T : in out Dynamic_Hash_Table)
+ is
begin
begin
Delete (T, 1);
@@ -276,7 +283,7 @@ procedure Dynhash is
procedure Check_Size
(Caller : String;
- T : Instance;
+ T : Dynamic_Hash_Table;
Exp_Count : Natural)
is
Count : constant Natural := Size (T);
@@ -305,7 +312,7 @@ procedure Dynhash is
procedure Test_Create (Init_Size : Positive) is
Count : Natural;
Iter : Iterator;
- T : Instance;
+ T : Dynamic_Hash_Table;
Val : Integer;
begin
@@ -402,7 +409,7 @@ procedure Dynhash is
Init_Size : Positive)
is
Exp_Val : Integer;
- T : Instance;
+ T : Dynamic_Hash_Table;
Val : Integer;
begin
@@ -483,7 +490,7 @@ procedure Dynhash is
is
Iter_1 : Iterator;
Iter_2 : Iterator;
- T : Instance;
+ T : Dynamic_Hash_Table;
begin
T := Create_And_Populate (Low_Key, High_Key, Init_Size);
@@ -552,7 +559,7 @@ procedure Dynhash is
procedure Test_Iterate_Empty (Init_Size : Positive) is
Iter : Iterator;
Key : Integer;
- T : Instance;
+ T : Dynamic_Hash_Table;
begin
T := Create_And_Populate (0, -1, Init_Size);
@@ -599,7 +606,7 @@ procedure Dynhash is
is
Iter : Iterator;
Key : Integer;
- T : Instance;
+ T : Dynamic_Hash_Table;
begin
T := Create_And_Populate (Low_Key, High_Key, Init_Size);
@@ -653,7 +660,7 @@ procedure Dynhash is
Init_Size : Positive)
is
Key : constant Integer := 1;
- T : Instance;
+ T : Dynamic_Hash_Table;
Val : Integer;
begin
@@ -687,7 +694,7 @@ procedure Dynhash is
High_Key : Integer;
Init_Size : Positive)
is
- T : Instance;
+ T : Dynamic_Hash_Table;
begin
T := Create_And_Populate (Low_Key, High_Key, Init_Size);
diff --git a/gcc/testsuite/gnat.dg/dynhash1.adb b/gcc/testsuite/gnat.dg/dynhash1.adb
index cbe241a..e2010de 100644
--- a/gcc/testsuite/gnat.dg/dynhash1.adb
+++ b/gcc/testsuite/gnat.dg/dynhash1.adb
@@ -1,14 +1,17 @@
+-- { dg-do run }
+
with Ada.Text_IO; use Ada.Text_IO;
with GNAT; use GNAT;
with GNAT.Dynamic_HTables; use GNAT.Dynamic_HTables;
procedure Dynhash1 is
+ procedure Destroy (Val : in out Integer) is null;
function Hash (Key : Integer) return Bucket_Range_Type is
begin
return Bucket_Range_Type (Key);
end Hash;
- package Integer_Hash_Tables is new Dynamic_HTable
+ package Integer_Hash_Tables is new Dynamic_Hash_Tables
(Key_Type => Integer,
Value_Type => Integer,
No_Value => 0,
@@ -17,11 +20,12 @@ procedure Dynhash1 is
Compression_Threshold => 0.3,
Compression_Factor => 2,
"=" => "=",
+ Destroy_Value => Destroy,
Hash => Hash);
use Integer_Hash_Tables;
Siz : Natural;
- T : Instance;
+ T : Dynamic_Hash_Table;
begin
T := Create (8);