From: Gary Dismukes <dismu...@adacore.com>
Constraint_Error is raised on evaluation of a container aggregate with
a loop_parameter_specification for the type Indefinite_Vector. This
happens due to the Aggregate aspect for type Indefinite_Vector specifying
the Empty_Vector constant for the type's Empty operation rather than
using the type's primitive Empty function. This problem shows up as
a recent regression relative to earlier compilers, evidently due to
recent fixes in the container aggregate area, which uncovered this
issue of the wrong specification in Ada.Containers.Indefinite_Vectors.
The compiler incorrectly initializes the aggregate object using the
Empty_Vector constant rather than invoking the New_Vector function
to allocate the vector object with the appropriate number of elements,
and subsequent calls to Replace_Element fail because the vector object
is empty.
In addition to correcting the Indefinite_Vectors generic package,
checking is added to give an error for an attempt to specify the
Empty operation as a constant rather than a function. (Also note
that another AdaCore package that needs a similar correction is
the VSS.Vector_Strings package.)
gcc/ada/
* libgnat/a-coinve.ads (type Vector): In the Aggregate aspect for
this type, the Empty operation is changed to denote the Empty
function, rather than the Empty_Vector constant.
* exp_aggr.adb (Expand_Container_Aggregate): Remove code for
handling the case where the Empty_Subp denotes a constant object,
which should never happen (and add an assertion that Empty_Subp
must denote a function).
* sem_ch13.adb (Valid_Empty): No longer allow the entity to be an
E_Constant, and require the (optional) parameter of an Empty
function to be of a signed integer type (rather than any integer
type).
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_aggr.adb | 24 +++++++++---------------
gcc/ada/libgnat/a-coinve.ads | 2 +-
gcc/ada/sem_ch13.adb | 5 +----
3 files changed, 11 insertions(+), 20 deletions(-)
diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f04dba719d9..5d2b334722a 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -7119,10 +7119,12 @@ package body Exp_Aggr is
Append (Init_Stat, Aggr_Code);
-- The container will grow dynamically. Create a declaration for
- -- the object, and initialize it either from a call to the Empty
- -- function, or from the Empty constant.
+ -- the object, and initialize it from a call to the parameterless
+ -- Empty function.
else
+ pragma Assert (Ekind (Entity (Empty_Subp)) = E_Function);
+
Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Temp,
@@ -7130,20 +7132,12 @@ package body Exp_Aggr is
Insert_Action (N, Decl);
- -- The Empty entity is either a parameterless function, or
- -- a constant.
-
- if Ekind (Entity (Empty_Subp)) = E_Function then
- Init_Stat := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Temp, Loc),
- Expression => Make_Function_Call (Loc,
- Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
+ -- The Empty entity is a parameterless function
- else
- Init_Stat := Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Temp, Loc),
- Expression => New_Occurrence_Of (Entity (Empty_Subp), Loc));
- end if;
+ Init_Stat := Make_Assignment_Statement (Loc,
+ Name => New_Occurrence_Of (Temp, Loc),
+ Expression => Make_Function_Call (Loc,
+ Name => New_Occurrence_Of (Entity (Empty_Subp), Loc)));
Append (Init_Stat, Aggr_Code);
end if;
diff --git a/gcc/ada/libgnat/a-coinve.ads b/gcc/ada/libgnat/a-coinve.ads
index 138ec3641c3..c51ec8aa06d 100644
--- a/gcc/ada/libgnat/a-coinve.ads
+++ b/gcc/ada/libgnat/a-coinve.ads
@@ -63,7 +63,7 @@ is
Variable_Indexing => Reference,
Default_Iterator => Iterate,
Iterator_Element => Element_Type,
- Aggregate => (Empty => Empty_Vector,
+ Aggregate => (Empty => Empty,
Add_Unnamed => Append,
New_Indexed => New_Vector,
Assign_Indexed => Replace_Element);
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 00392ae88eb..13bf93ca548 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -16527,13 +16527,10 @@ package body Sem_Ch13 is
if Etype (E) /= Typ or else Scope (E) /= Scope (Typ) then
return False;
- elsif Ekind (E) = E_Constant then
- return True;
-
elsif Ekind (E) = E_Function then
return No (First_Formal (E))
or else
- (Is_Integer_Type (Etype (First_Formal (E)))
+ (Is_Signed_Integer_Type (Etype (First_Formal (E)))
and then No (Next_Formal (First_Formal (E))));
else
return False;
--
2.43.2
