[multiple changes]
2014-10-30 Ed Schonberg <schonberg@adacore.com> * exp_ch3.adb (Expand_N_Object_Declaration): Code cleanup. 2014-10-30 Ed Schonberg <schonberg@adacore.com> * sem_ch5.adb (Analyze_Iterator_Specification): If a subtype indication is provided, check properly that it covers the element type of of the container type. 2014-10-30 Hristian Kirtchev <kirtchev@adacore.com> * g-dynhta.ads, g-dynhta.adb: Add the implementation of a load facto -based hash table. From-SVN: r216926
This commit is contained in:
Arnaud Charlet
parent
35fdafcdda
commit
cc9b1e1ca0
5 changed files with 517 additions and 26 deletions
|
|
@ -1,3 +1,18 @@
|
|||
2014-10-30 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_ch3.adb (Expand_N_Object_Declaration): Code cleanup.
|
||||
|
||||
2014-10-30 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* sem_ch5.adb (Analyze_Iterator_Specification): If a subtype
|
||||
indication is provided, check properly that it covers the element
|
||||
type of of the container type.
|
||||
|
||||
2014-10-30 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* g-dynhta.ads, g-dynhta.adb: Add the implementation of a load facto
|
||||
-based hash table.
|
||||
|
||||
2014-10-30 Ed Schonberg <schonberg@adacore.com>
|
||||
|
||||
* exp_util.ads, exp_util.adb (Following_Address_Clause): Modify
|
||||
|
|
|
|||
|
|
@ -5834,7 +5834,8 @@ package body Exp_Ch3 is
|
|||
or else Nkind (Expression (Expr)) /= N_Aggregate)
|
||||
then
|
||||
declare
|
||||
Full_Typ : constant Entity_Id := Underlying_Type (Typ);
|
||||
Full_Typ : constant Entity_Id := Underlying_Type (Typ);
|
||||
Tag_Assign : Node_Id;
|
||||
|
||||
begin
|
||||
-- The re-assignment of the tag has to be done even if the
|
||||
|
|
@ -5849,6 +5850,16 @@ package body Exp_Ch3 is
|
|||
Loc));
|
||||
Set_Assignment_OK (New_Ref);
|
||||
|
||||
Tag_Assign :=
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Ref,
|
||||
Expression =>
|
||||
Unchecked_Convert_To (RTE (RE_Tag),
|
||||
New_Occurrence_Of
|
||||
(Node
|
||||
(First_Elmt (Access_Disp_Table (Full_Typ))),
|
||||
Loc)));
|
||||
|
||||
-- Tag initialization cannot be done before object is
|
||||
-- frozen. If an address clause follows, make sure freeze
|
||||
-- node exists, and insert it and the tag assignment after
|
||||
|
|
@ -5856,20 +5867,9 @@ package body Exp_Ch3 is
|
|||
|
||||
if Present (Following_Address_Clause (N)) then
|
||||
Init_After := Following_Address_Clause (N);
|
||||
Ensure_Freeze_Node (Def_Id);
|
||||
end if;
|
||||
|
||||
Insert_Actions_After (Init_After,
|
||||
New_List (
|
||||
Freeze_Node (Def_Id),
|
||||
Make_Assignment_Statement (Loc,
|
||||
Name => New_Ref,
|
||||
Expression =>
|
||||
Unchecked_Convert_To (RTE (RE_Tag),
|
||||
New_Occurrence_Of
|
||||
(Node
|
||||
(First_Elmt (Access_Disp_Table (Full_Typ))),
|
||||
Loc)))));
|
||||
Insert_Action_After (Init_After, Tag_Assign);
|
||||
end;
|
||||
|
||||
-- Handle C++ constructor calls. Note that we do not check that
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- B o d y --
|
||||
-- --
|
||||
-- Copyright (C) 2002-2010, AdaCore --
|
||||
-- Copyright (C) 2002-2014, AdaCore --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -29,6 +29,8 @@
|
|||
-- --
|
||||
------------------------------------------------------------------------------
|
||||
|
||||
with Ada.Unchecked_Deallocation;
|
||||
|
||||
package body GNAT.Dynamic_HTables is
|
||||
|
||||
-------------------
|
||||
|
|
@ -215,6 +217,8 @@ package body GNAT.Dynamic_HTables is
|
|||
-------------------
|
||||
|
||||
package body Simple_HTable is
|
||||
procedure Free is new
|
||||
Ada.Unchecked_Deallocation (Element_Wrapper, Elmt_Ptr);
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
|
|
@ -343,4 +347,364 @@ package body GNAT.Dynamic_HTables is
|
|||
|
||||
end Simple_HTable;
|
||||
|
||||
------------------------
|
||||
-- Load_Factor_HTable --
|
||||
------------------------
|
||||
|
||||
package body Load_Factor_HTable is
|
||||
|
||||
Min_Size_Increase : constant := 5;
|
||||
-- The minimum increase expressed as number of buckets. This value is
|
||||
-- used to determine the new size of small tables and/or small growth
|
||||
-- percentages.
|
||||
|
||||
procedure Attach
|
||||
(Elmt : not null Element_Ptr;
|
||||
Chain : not null Element_Ptr);
|
||||
-- Prepend an element to a bucket chain. Elmt is inserted after the
|
||||
-- dummy head of Chain.
|
||||
|
||||
function Create_Buckets (Size : Positive) return Buckets_Array_Ptr;
|
||||
-- Allocate and initialize a new set of buckets. The buckets are created
|
||||
-- in the range Range_Type'First .. Range_Type'First + Size - 1.
|
||||
|
||||
procedure Detach (Elmt : not null Element_Ptr);
|
||||
-- Remove an element from an arbitrary bucket chain
|
||||
|
||||
function Find
|
||||
(Key : Key_Type;
|
||||
Chain : not null Element_Ptr) return Element_Ptr;
|
||||
-- Try to locate the element which contains a particular key within a
|
||||
-- bucket chain. If no such element exists, return No_Element.
|
||||
|
||||
procedure Free is
|
||||
new Ada.Unchecked_Deallocation (Buckets_Array, Buckets_Array_Ptr);
|
||||
|
||||
procedure Free is
|
||||
new Ada.Unchecked_Deallocation (Element, Element_Ptr);
|
||||
|
||||
function Is_Empty_Chain (Chain : not null Element_Ptr) return Boolean;
|
||||
-- Determine whether a bucket chain contains only one element, namely
|
||||
-- the dummy head.
|
||||
|
||||
------------
|
||||
-- Attach --
|
||||
------------
|
||||
|
||||
procedure Attach
|
||||
(Elmt : not null Element_Ptr;
|
||||
Chain : not null Element_Ptr)
|
||||
is
|
||||
begin
|
||||
Chain.Next.Prev := Elmt;
|
||||
Elmt.Next := Chain.Next;
|
||||
Chain.Next := Elmt;
|
||||
Elmt.Prev := Chain;
|
||||
end Attach;
|
||||
|
||||
--------------------
|
||||
-- Create_Buckets --
|
||||
--------------------
|
||||
|
||||
function Create_Buckets (Size : Positive) return Buckets_Array_Ptr is
|
||||
Low_Bound : constant Range_Type := Range_Type'First;
|
||||
Buckets : Buckets_Array_Ptr;
|
||||
|
||||
begin
|
||||
Buckets :=
|
||||
new Buckets_Array (Low_Bound .. Low_Bound + Range_Type (Size) - 1);
|
||||
|
||||
-- Ensure that the dummy head of each bucket chain points to itself
|
||||
-- in both directions.
|
||||
|
||||
for Index in Buckets'Range loop
|
||||
declare
|
||||
Bucket : Element renames Buckets (Index);
|
||||
|
||||
begin
|
||||
Bucket.Prev := Bucket'Unchecked_Access;
|
||||
Bucket.Next := Bucket'Unchecked_Access;
|
||||
end;
|
||||
end loop;
|
||||
|
||||
return Buckets;
|
||||
end Create_Buckets;
|
||||
|
||||
------------------
|
||||
-- Current_Size --
|
||||
------------------
|
||||
|
||||
function Current_Size (T : Table) return Positive is
|
||||
begin
|
||||
-- The table should have been properly initialized during object
|
||||
-- elaboration.
|
||||
|
||||
if T.Buckets = null then
|
||||
raise Program_Error;
|
||||
|
||||
-- The size of the table is determined by the number of buckets
|
||||
|
||||
else
|
||||
return T.Buckets'Length;
|
||||
end if;
|
||||
end Current_Size;
|
||||
|
||||
------------
|
||||
-- Detach --
|
||||
------------
|
||||
|
||||
procedure Detach (Elmt : not null Element_Ptr) is
|
||||
begin
|
||||
if Elmt.Prev /= null and Elmt.Next /= null then
|
||||
Elmt.Prev.Next := Elmt.Next;
|
||||
Elmt.Next.Prev := Elmt.Prev;
|
||||
Elmt.Prev := null;
|
||||
Elmt.Next := null;
|
||||
end if;
|
||||
end Detach;
|
||||
|
||||
--------------
|
||||
-- Finalize --
|
||||
--------------
|
||||
|
||||
procedure Finalize (T : in out Table) is
|
||||
Bucket : Element_Ptr;
|
||||
Elmt : Element_Ptr;
|
||||
|
||||
begin
|
||||
-- Inspect the buckets and deallocate bucket chains
|
||||
|
||||
for Index in T.Buckets'Range loop
|
||||
Bucket := T.Buckets (Index)'Unchecked_Access;
|
||||
|
||||
-- The current bucket chain contains an element other than the
|
||||
-- dummy head.
|
||||
|
||||
while not Is_Empty_Chain (Bucket) loop
|
||||
|
||||
-- Skip the dummy head, remove and deallocate the element
|
||||
|
||||
Elmt := Bucket.Next;
|
||||
Detach (Elmt);
|
||||
Free (Elmt);
|
||||
end loop;
|
||||
end loop;
|
||||
|
||||
-- Deallocate the buckets
|
||||
|
||||
Free (T.Buckets);
|
||||
end Finalize;
|
||||
|
||||
----------
|
||||
-- Find --
|
||||
----------
|
||||
|
||||
function Find
|
||||
(Key : Key_Type;
|
||||
Chain : not null Element_Ptr) return Element_Ptr
|
||||
is
|
||||
Elmt : Element_Ptr;
|
||||
|
||||
begin
|
||||
-- Skip the dummy head, inspect the bucket chain for an element whose
|
||||
-- key matches the requested key. Since each bucket chain is curcular
|
||||
-- the search must stop once the dummy head is encountered.
|
||||
|
||||
Elmt := Chain.Next;
|
||||
while Elmt /= Chain loop
|
||||
if Equal (Elmt.Key, Key) then
|
||||
return Elmt;
|
||||
end if;
|
||||
|
||||
Elmt := Elmt.Next;
|
||||
end loop;
|
||||
|
||||
return No_Element;
|
||||
end Find;
|
||||
|
||||
---------
|
||||
-- Get --
|
||||
---------
|
||||
|
||||
function Get (T : Table; Key : Key_Type) return Value_Type is
|
||||
Bucket : Element_Ptr;
|
||||
Elmt : Element_Ptr;
|
||||
|
||||
begin
|
||||
-- Obtain the bucket chain where the (key, value) pair should reside
|
||||
-- by calculating the proper hash location.
|
||||
|
||||
Bucket := T.Buckets (Hash (Key, Current_Size (T)))'Unchecked_Access;
|
||||
|
||||
-- Try to find an element whose key matches the requested key
|
||||
|
||||
Elmt := Find (Key, Bucket);
|
||||
|
||||
-- The hash table does not contain a matching (key, value) pair
|
||||
|
||||
if Elmt = No_Element then
|
||||
return No_Value;
|
||||
else
|
||||
return Elmt.Val;
|
||||
end if;
|
||||
end Get;
|
||||
|
||||
----------------
|
||||
-- Initialize --
|
||||
----------------
|
||||
|
||||
procedure Initialize (T : in out Table) is
|
||||
begin
|
||||
pragma Assert (T.Buckets = null);
|
||||
|
||||
T.Buckets := Create_Buckets (Initial_Size);
|
||||
T.Element_Count := 0;
|
||||
end Initialize;
|
||||
|
||||
--------------------
|
||||
-- Is_Empty_Chain --
|
||||
--------------------
|
||||
|
||||
function Is_Empty_Chain (Chain : not null Element_Ptr) return Boolean is
|
||||
begin
|
||||
return Chain.Next = Chain and Chain.Prev = Chain;
|
||||
end Is_Empty_Chain;
|
||||
|
||||
------------
|
||||
-- Remove --
|
||||
------------
|
||||
|
||||
procedure Remove (T : in out Table; Key : Key_Type) is
|
||||
Bucket : Element_Ptr;
|
||||
Elmt : Element_Ptr;
|
||||
|
||||
begin
|
||||
-- Obtain the bucket chain where the (key, value) pair should reside
|
||||
-- by calculating the proper hash location.
|
||||
|
||||
Bucket := T.Buckets (Hash (Key, Current_Size (T)))'Unchecked_Access;
|
||||
|
||||
-- Try to find an element whose key matches the requested key
|
||||
|
||||
Elmt := Find (Key, Bucket);
|
||||
|
||||
-- Remove and deallocate the (key, value) pair
|
||||
|
||||
if Elmt /= No_Element then
|
||||
Detach (Elmt);
|
||||
Free (Elmt);
|
||||
end if;
|
||||
end Remove;
|
||||
|
||||
---------
|
||||
-- Set --
|
||||
---------
|
||||
|
||||
procedure Set
|
||||
(T : in out Table;
|
||||
Key : Key_Type;
|
||||
Val : Value_Type)
|
||||
is
|
||||
Curr_Size : constant Positive := Current_Size (T);
|
||||
|
||||
procedure Grow;
|
||||
-- Grow the table to a new size according to the desired percentage
|
||||
-- and relocate all existing elements to the new buckets.
|
||||
|
||||
----------
|
||||
-- Grow --
|
||||
----------
|
||||
|
||||
procedure Grow is
|
||||
Buckets : Buckets_Array_Ptr;
|
||||
Elmt : Element_Ptr;
|
||||
Hash_Loc : Range_Type;
|
||||
Old_Bucket : Element_Ptr;
|
||||
Old_Buckets : Buckets_Array_Ptr := T.Buckets;
|
||||
Size : Positive;
|
||||
|
||||
begin
|
||||
-- Calculate the new size and allocate a new set of buckets. Note
|
||||
-- that a table with a small size or a small growth percentage may
|
||||
-- not always grow (for example, 10 buckets and 3% increase). In
|
||||
-- that case, enforce a minimum increase.
|
||||
|
||||
Size :=
|
||||
Positive'Max (Curr_Size * ((100 + Growth_Percentage) / 100),
|
||||
Min_Size_Increase);
|
||||
Buckets := Create_Buckets (Size);
|
||||
|
||||
-- Inspect the old buckets and transfer all elements by rehashing
|
||||
-- all (key, value) pairs in the new buckets.
|
||||
|
||||
for Index in Old_Buckets'Range loop
|
||||
Old_Bucket := Old_Buckets (Index)'Unchecked_Access;
|
||||
|
||||
-- The current bucket chain contains an element other than the
|
||||
-- dummy head.
|
||||
|
||||
while not Is_Empty_Chain (Old_Bucket) loop
|
||||
|
||||
-- Skip the dummy head and find the new hash location
|
||||
|
||||
Elmt := Old_Bucket.Next;
|
||||
Hash_Loc := Hash (Elmt.Key, Size);
|
||||
|
||||
-- Remove the element from the old buckets and insert it
|
||||
-- into the new buckets. Note that there is no need to check
|
||||
-- for duplicates because the hash table did not have any to
|
||||
-- begin with.
|
||||
|
||||
Detach (Elmt);
|
||||
Attach
|
||||
(Elmt => Elmt,
|
||||
Chain => Buckets (Hash_Loc)'Unchecked_Access);
|
||||
end loop;
|
||||
end loop;
|
||||
|
||||
-- Associate the new buckets with the table and reclaim the
|
||||
-- storage occupied by the old buckets.
|
||||
|
||||
T.Buckets := Buckets;
|
||||
|
||||
Free (Old_Buckets);
|
||||
end Grow;
|
||||
|
||||
-- Local variables
|
||||
|
||||
subtype LLF is Long_Long_Float;
|
||||
|
||||
Count : Natural renames T.Element_Count;
|
||||
Bucket : Element_Ptr;
|
||||
Hash_Loc : Range_Type;
|
||||
|
||||
-- Start of processing for Set
|
||||
|
||||
begin
|
||||
-- Find the bucket where the (key, value) pair should be inserted by
|
||||
-- computing the proper hash location.
|
||||
|
||||
Hash_Loc := Hash (Key, Curr_Size);
|
||||
Bucket := T.Buckets (Hash_Loc)'Unchecked_Access;
|
||||
|
||||
-- Ensure that the key is not already present in the bucket in order
|
||||
-- to avoid duplicates.
|
||||
|
||||
if Find (Key, Bucket) = No_Element then
|
||||
Attach
|
||||
(Elmt => new Element'(Key, Val, null, null),
|
||||
Chain => Bucket);
|
||||
Count := Count + 1;
|
||||
|
||||
-- Multiple insertions may cause long bucket chains and decrease
|
||||
-- the performance of basic operations. If this is the case, grow
|
||||
-- the table and rehash all existing elements.
|
||||
|
||||
if (LLF (Count) / LLF (Curr_Size)) > LLF (Load_Factor) then
|
||||
Grow;
|
||||
end if;
|
||||
end if;
|
||||
end Set;
|
||||
end Load_Factor_HTable;
|
||||
|
||||
end GNAT.Dynamic_HTables;
|
||||
|
|
|
|||
|
|
@ -6,7 +6,7 @@
|
|||
-- --
|
||||
-- S p e c --
|
||||
-- --
|
||||
-- Copyright (C) 1995-2013, AdaCore --
|
||||
-- Copyright (C) 1995-2014, AdaCore --
|
||||
-- --
|
||||
-- GNAT is free software; you can redistribute it and/or modify it under --
|
||||
-- terms of the GNU General Public License as published by the Free Soft- --
|
||||
|
|
@ -31,11 +31,13 @@
|
|||
|
||||
-- Hash table searching routines
|
||||
|
||||
-- This package contains two separate packages. The Simple_HTable package
|
||||
-- provides a very simple abstraction that associates one element to one
|
||||
-- key value and takes care of all allocations automatically using the heap.
|
||||
-- The Static_HTable package provides a more complex interface that allows
|
||||
-- complete control over allocation.
|
||||
-- This package contains three separate packages. The Simple_HTable package
|
||||
-- provides a very simple abstraction that associates one element to one key
|
||||
-- value and takes care of all allocations automatically using the heap. The
|
||||
-- Static_HTable package provides a more complex interface that allows full
|
||||
-- control over allocation. The Load_Factor_HTable package provides a more
|
||||
-- complex abstraction where collisions are resolved by chaining, and the
|
||||
-- table grows by a percentage after the load factor has been exceeded.
|
||||
|
||||
-- This package provides a facility similar to that of GNAT.HTable, except
|
||||
-- that this package declares types that can be used to define dynamic
|
||||
|
|
@ -46,7 +48,8 @@
|
|||
-- GNAT.HTable to keep as much coherency as possible between these two
|
||||
-- related units.
|
||||
|
||||
with Ada.Unchecked_Deallocation;
|
||||
private with Ada.Finalization;
|
||||
|
||||
package GNAT.Dynamic_HTables is
|
||||
|
||||
-------------------
|
||||
|
|
@ -210,9 +213,6 @@ package GNAT.Dynamic_HTables is
|
|||
Next : Elmt_Ptr;
|
||||
end record;
|
||||
|
||||
procedure Free is new
|
||||
Ada.Unchecked_Deallocation (Element_Wrapper, Elmt_Ptr);
|
||||
|
||||
procedure Set_Next (E : Elmt_Ptr; Next : Elmt_Ptr);
|
||||
function Next (E : Elmt_Ptr) return Elmt_Ptr;
|
||||
function Get_Key (E : Elmt_Ptr) return Key;
|
||||
|
|
@ -234,4 +234,116 @@ package GNAT.Dynamic_HTables is
|
|||
|
||||
end Simple_HTable;
|
||||
|
||||
------------------------
|
||||
-- Load_Factor_HTable --
|
||||
------------------------
|
||||
|
||||
-- A simple hash table abstraction capable of growing once a treshold has
|
||||
-- been exceeded. Collisions are resolved by chaining elements onto lists
|
||||
-- hanging from individual buckets. This implementation does not make any
|
||||
-- effort in minimizing the number of necessary rehashes once the table has
|
||||
-- been expanded, hence the term "simple".
|
||||
|
||||
-- WARNING: This hash table implementation utilizes dynamic allocation.
|
||||
-- Storage reclamation is performed by the hash table.
|
||||
|
||||
-- WARNING: This hash table implementation is not thread-safe. To achieve
|
||||
-- proper concurrency and synchronization, wrap an instance of a table in
|
||||
-- a protected object.
|
||||
|
||||
generic
|
||||
type Range_Type is range <>;
|
||||
-- The underlying range of the hash table. Note that this type must be
|
||||
-- large enough to accomodate multiple expansions of the table.
|
||||
|
||||
type Key_Type is private;
|
||||
type Value_Type is private;
|
||||
-- The types of the (key, value) pair stored in the hash table
|
||||
|
||||
No_Value : Value_Type;
|
||||
-- A predefined value denoting a non-existent value
|
||||
|
||||
Initial_Size : Positive;
|
||||
-- The starting size of the hash table. The hash table must contain at
|
||||
-- least one bucket.
|
||||
|
||||
Growth_Percentage : Positive;
|
||||
-- The amount of increase expressed as a percentage. The hash table must
|
||||
-- grow by at least 1%. To illustrate, a value of 100 will increase the
|
||||
-- table by 100% effectively doubling its size.
|
||||
|
||||
Load_Factor : Float;
|
||||
-- The ratio of the elements stored within the hash table divided by the
|
||||
-- current size of the table. This value acts as the growth treshold. If
|
||||
-- exceeded, the hash table is expanded by Growth_Percentage.
|
||||
|
||||
with function Equal
|
||||
(Left : Key_Type;
|
||||
Right : Key_Type) return Boolean;
|
||||
|
||||
with function Hash
|
||||
(Key : Key_Type;
|
||||
Size : Positive) return Range_Type;
|
||||
-- Parameter Size denotes the current size of the hash table
|
||||
|
||||
package Load_Factor_HTable is
|
||||
type Table is tagged limited private;
|
||||
|
||||
function Current_Size (T : Table) return Positive;
|
||||
-- Obtain the current size of the table
|
||||
|
||||
function Get (T : Table; Key : Key_Type) return Value_Type;
|
||||
-- Obtain the value associated with a key. This routne returns No_Value
|
||||
-- if the key is not present in the hash table.
|
||||
|
||||
procedure Remove (T : in out Table; Key : Key_Type);
|
||||
-- Remove the value associated with the given key. This routine has no
|
||||
-- effect if the key is not present in the hash table.
|
||||
|
||||
procedure Set
|
||||
(T : in out Table;
|
||||
Key : Key_Type;
|
||||
Val : Value_Type);
|
||||
-- Associate a value with a given key. This routine has no effect if the
|
||||
-- the (key, value) pair is already present in the hash table. Note that
|
||||
-- this action may cause the table to grow.
|
||||
|
||||
private
|
||||
-- The following types model a bucket chain. Note that the key is also
|
||||
-- stored for rehashing purposes.
|
||||
|
||||
type Element;
|
||||
type Element_Ptr is access all Element;
|
||||
type Element is record
|
||||
Key : Key_Type;
|
||||
Val : Value_Type;
|
||||
Prev : Element_Ptr := null;
|
||||
Next : Element_Ptr := null;
|
||||
end record;
|
||||
|
||||
No_Element : constant Element_Ptr := null;
|
||||
|
||||
-- The following types model the buckets of the hash table. Each bucket
|
||||
-- has a dummy head to facilitate insertion and deletion of elements.
|
||||
|
||||
type Buckets_Array is array (Range_Type range <>) of aliased Element;
|
||||
type Buckets_Array_Ptr is access all Buckets_Array;
|
||||
|
||||
type Table is new Ada.Finalization.Limited_Controlled with record
|
||||
Buckets : Buckets_Array_Ptr := null;
|
||||
|
||||
Element_Count : Natural := 0;
|
||||
-- The number of (key, value) pairs stored in the hash table
|
||||
end record;
|
||||
|
||||
procedure Finalize (T : in out Table);
|
||||
-- Destroy the contents of a hash table by reclaiming all storage used
|
||||
-- by buckets and their respective chains.
|
||||
|
||||
procedure Initialize (T : in out Table);
|
||||
-- Create a hash table with buckets within the range Range_Type'First ..
|
||||
-- Range_Type'First + Initial_Size - 1.
|
||||
|
||||
end Load_Factor_HTable;
|
||||
|
||||
end GNAT.Dynamic_HTables;
|
||||
|
|
|
|||
|
|
@ -2009,10 +2009,10 @@ package body Sem_Ch5 is
|
|||
Set_Etype (Def_Id, Entity (Element));
|
||||
|
||||
-- If subtype indication was given, verify that it
|
||||
-- matches element type of container.
|
||||
-- covers the element type of the container.
|
||||
|
||||
if Present (Subt)
|
||||
and then Bas /= Base_Type (Etype (Def_Id))
|
||||
and then not Covers (Bas, Etype (Def_Id))
|
||||
then
|
||||
Error_Msg_N
|
||||
("subtype indication does not match element type",
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue