https://gcc.gnu.org/g:cdbd7946acc884901c06ec40162e47923d941f12
commit r16-2412-gcdbd7946acc884901c06ec40162e47923d941f12
Author: Gary Dismukes <dismu...@adacore.com>
Date: Mon Jul 7 20:59:18 2025 +0000
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:
---
gcc/ada/exp_aggr.adb | 42 +++++++++++++++++++++++++++---------------
gcc/ada/libgnat/a-cbhama.adb | 2 +-
gcc/ada/libgnat/a-cbhama.ads | 2 +-
3 files changed, 29 insertions(+), 17 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 987db2a5d813..9458bdea6633 100644
--- 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 ee6584dc3b10..b2d796446fdd 100644
--- 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 6ffc8157e85f..c741b404da4d 100644
--- 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
