diff options
author | Hristian Kirtchev <kirtchev@adacore.com> | 2019-07-01 13:34:55 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2019-07-01 13:34:55 +0000 |
commit | 7f070fc469c71b0d3e435cf23964b6de7cd9943e (patch) | |
tree | 8bd656f2847fec5157f09040944b427b132db2ce | |
parent | 68f27c97bff2d21c107ca90e1b597fed45b52ba5 (diff) | |
download | gcc-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/ChangeLog | 8 | ||||
-rw-r--r-- | gcc/ada/libgnat/g-dynhta.adb | 93 | ||||
-rw-r--r-- | gcc/ada/libgnat/g-dynhta.ads | 51 | ||||
-rw-r--r-- | gcc/testsuite/ChangeLog | 4 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/dynhash.adb | 41 | ||||
-rw-r--r-- | gcc/testsuite/gnat.dg/dynhash1.adb | 8 |
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); |