ada: Additional condition for Capacity discriminant on bounded container aggregates

This change test an additional condition as part of the criteria used
for deciding whether to generate a call to a container type's Length
function (for passing to the Empty function) when determining the
size of the object to allocate for a bounded container aggregate
with a "for of" iterator.

An update is also made to function Empty in Ada.Containers.Bounded_Hash_Maps,
adding a default to the formal Capacity, to make it consistent with other
bounded containers (and to make it conformant with the Ada RM).

gcc/ada/ChangeLog:

	* libgnat/a-cbhama.ads (Empty): Add missing default to Capacity formal.
	* libgnat/a-cbhama.adb (Empty): Add missing default to Capacity formal.
	* exp_aggr.adb (Build_Size_Expr): Test for presence of Capacity
	discriminant as additional criterion for generating the call to
	the Length function. Update comments.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 987db2a5d813493f4b7cb9d54a27f2bacd0ad3b7..9458bdea66330fcf44efba879280e56707f1c6b9 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -6874,6 +6874,7 @@ package body Exp_Aggr is
                  and then not Is_Class_Wide_Type (It_Subt)
                then
                   declare
+                     Aggr_Base    : constant Entity_Id := Base_Type (Typ);
                      It_Base      : constant Entity_Id := Base_Type (It_Subt);
                      Empty_Formal : constant Entity_Id :=
                                       First_Formal (Entity (Empty_Subp));
@@ -6886,16 +6887,27 @@ package body Exp_Aggr is
                      --  generally have a Length function. User-defined
                      --  containers don't necessarily have such a function,
                      --  or it may be named differently, or it may have
-                     --  the wrong semantics. The base subtype is tested,
-                     --  since its Sloc will refer to the original container
-                     --  generic in the predefined library, even though it's
-                     --  declared in a package instantiation within the current
-                     --  library unit. Also, this is only done when Empty_Subp
-                     --  has a formal parameter (usually named Capacity), and
-                     --  not in the case of a parameterless Empty function.
-
-                     if In_Predefined_Unit (It_Base)
-                       and then Present (Empty_Formal)
+                     --  the wrong semantics. The base subtypes are tested,
+                     --  since their Sloc will refer to the original container
+                     --  generics in the predefined library, even though the
+                     --  types are declared in a package instantiation in some
+                     --  other unit. Also, this is only done when Empty_Subp
+                     --  has a formal parameter (generally named Capacity),
+                     --  and not in the case of a parameterless Empty function.
+                     --  Finally, we test for the container aggregate's type
+                     --  having a first discriminant with the name Capacity,
+                     --  since determining capacity via Length is only sensible
+                     --  for container types with that discriminant (bounded
+                     --  containers).
+
+                     if Present (Empty_Formal)
+                       and then In_Predefined_Unit (It_Base)
+                       and then In_Predefined_Unit (Aggr_Base)
+                       and then Has_Discriminants (Aggr_Base)
+                       and then
+                         Get_Name_String
+                           (Chars (First_Discriminant (Aggr_Base)))
+                           = "capacity"
                      then
                         --  Look for the container type's Length function in
                         --  the package where it's defined.
@@ -6907,11 +6919,11 @@ package body Exp_Aggr is
                         Pop_Scope;
 
                         --  If we found a Length function that has a single
-                        --  parameter of the container type, then expand a call
-                        --  to that, passing the container object named in the
-                        --  iterator_specification, and return that call, which
-                        --  will be used as the "size" of the current aggregate
-                        --  element association.
+                        --  parameter of the iterator object's container type,
+                        --  then expand a call to that, passing the object,
+                        --  and return that call, which will be used as the
+                        --  "size" of the current element association of the
+                        --  bounded container aggregate.
 
                         if Present (Length_Subp)
                           and then Ekind (Length_Subp) = E_Function

diff --git a/gcc/ada/libgnat/a-cbhama.adb b/gcc/ada/libgnat/a-cbhama.adb
index ee6584dc3b109feb9d72c071469d5f3832b0a49b..b2d796446fdd8e5cb6b6b8e9967d7ecb4f2dd87e 100644 (file)
--- a/gcc/ada/libgnat/a-cbhama.adb
+++ b/gcc/ada/libgnat/a-cbhama.adb
@@ -368,7 +368,7 @@ is
    -- Empty --
    -----------
 
-   function Empty (Capacity : Count_Type) return Map is
+   function Empty (Capacity : Count_Type := 10) return Map is
    begin
       return Result : Map (Capacity, 0) do
          null;

diff --git a/gcc/ada/libgnat/a-cbhama.ads b/gcc/ada/libgnat/a-cbhama.ads
index 6ffc8157e85f0b98504dc47eb3d03accfd0e9e3d..c741b404da4d24c41a5a36e9b098425f6571e820 100644 (file)
--- a/gcc/ada/libgnat/a-cbhama.ads
+++ b/gcc/ada/libgnat/a-cbhama.ads
@@ -71,7 +71,7 @@ is
    --  Map objects declared without an initialization expression are
    --  initialized to the value Empty_Map.
 
-   function Empty (Capacity : Count_Type) return Map;
+   function Empty (Capacity : Count_Type := 10) return Map;
 
    No_Element : constant Cursor;
    --  Cursor objects declared without an initialization expression are