diff options
author | Gary Dismukes <dismukes@adacore.com> | 2024-02-27 22:05:55 +0000 |
---|---|---|
committer | Marc Poulhiès <poulhies@adacore.com> | 2024-05-16 10:49:34 +0200 |
commit | 9ec20f1f84ad19bb8e2020657ee4c851ba5cd7b0 (patch) | |
tree | f3772236d8c74d9e82c5de09e2eaa27111cae875 /gcc/ada | |
parent | 568c79570a569256d6191e20a6491ba304b28a04 (diff) | |
download | gcc-9ec20f1f84ad19bb8e2020657ee4c851ba5cd7b0.zip gcc-9ec20f1f84ad19bb8e2020657ee4c851ba5cd7b0.tar.gz gcc-9ec20f1f84ad19bb8e2020657ee4c851ba5cd7b0.tar.bz2 |
ada: Exception on Indefinite_Vector aggregate with loop_parameter_specification
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).
Diffstat (limited to 'gcc/ada')
-rw-r--r-- | gcc/ada/exp_aggr.adb | 24 | ||||
-rw-r--r-- | gcc/ada/libgnat/a-coinve.ads | 2 | ||||
-rw-r--r-- | 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 f04dba7..5d2b334 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 138ec36..c51ec8a 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 00392ae..13bf93c 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; |