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).

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index f04dba719d9250b27b0247edeed5b11dea19c79a..5d2b334722a2f20e0dca848ac22cb8dfe288889b 100644 (file)
--- 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 138ec3641c3f0d9095280306b6e8b47577d1d951..c51ec8aa06dc331cfbaebdd607ecd7b5277b0880 100644 (file)
--- 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 00392ae88ebe983b6f7b2e30a6fba63fd28772be..13bf93ca548932ebf43ee19402986cd35a6556eb 100644 (file)
--- 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;