aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorGary Dismukes <dismukes@adacore.com>2024-02-27 22:05:55 +0000
committerMarc Poulhiès <poulhies@adacore.com>2024-05-16 10:49:34 +0200
commit9ec20f1f84ad19bb8e2020657ee4c851ba5cd7b0 (patch)
treef3772236d8c74d9e82c5de09e2eaa27111cae875 /gcc/ada
parent568c79570a569256d6191e20a6491ba304b28a04 (diff)
downloadgcc-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.adb24
-rw-r--r--gcc/ada/libgnat/a-coinve.ads2
-rw-r--r--gcc/ada/sem_ch13.adb5
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;