diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 09363af823e61ae38171d294b3b3ec08bf4362b5..da997c0dac6bb7305463faf3001953c2bee9a94d 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -887,12 +887,31 @@ package body Freeze is (T : Entity_Id) return Boolean is Constraint : Elmt_Id; + Discr : Entity_Id; begin if Has_Discriminants (T) and then Present (Discriminant_Constraint (T)) and then Present (First_Component (T)) then + Discr := First_Discriminant (T); + + if Is_Access_Type (Etype (Discr)) then + null; + + -- If the bounds of the discriminant are not compile-time known, + -- treat this as non-static, even if the value of the discriminant + -- is compile-time known, because the back-end treats aggregates + -- of such a subtype as having unknown size. + + elsif not + (Compile_Time_Known_Value (Type_Low_Bound (Etype (Discr))) + and then + Compile_Time_Known_Value (Type_High_Bound (Etype (Discr)))) + then + return False; + end if; + Constraint := First_Elmt (Discriminant_Constraint (T)); while Present (Constraint) loop if not Compile_Time_Known_Value (Node (Constraint)) then diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 580dc29af450652c2d49316f8da75fa80b416924..9f0c5fc80dd004588d76c6a2650e997abaf81b5f 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -731,13 +731,10 @@ package body Sem_Aggr is Name_Buffer (1 .. Name_Len); begin - Component_Elmt := First_Elmt (Elements); - while Nr_Of_Suggestions <= Max_Suggestions and then Present (Component_Elmt) loop - Get_Name_String (Chars (Node (Component_Elmt))); if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then @@ -785,12 +782,23 @@ package body Sem_Aggr is elsif Nkind (V) /= N_Integer_Literal then return; + + elsif Is_Access_Type (Etype (Disc)) then + null; + + -- If the bounds of the discriminant type are not compile time known, + -- the back-end will treat this as a variable-size object. + + elsif not + (Compile_Time_Known_Value (Type_Low_Bound (Etype (Disc))) + and then + Compile_Time_Known_Value (Type_High_Bound (Etype (Disc)))) + then + return; end if; Comp := First_Component (T); - while Present (Comp) loop - if Is_Scalar_Type (Etype (Comp)) then null; @@ -801,15 +809,12 @@ package body Sem_Aggr is null; elsif Is_Array_Type (Etype (Comp)) then - if Is_Bit_Packed_Array (Etype (Comp)) then return; end if; Ind := First_Index (Etype (Comp)); - while Present (Ind) loop - if Nkind (Ind) /= N_Range or else Nkind (Low_Bound (Ind)) /= N_Integer_Literal or else Nkind (High_Bound (Ind)) /= N_Integer_Literal @@ -1615,7 +1620,6 @@ package body Sem_Aggr is Assoc := First (Component_Associations (N)); while Present (Assoc) loop - Prev_Nb_Discrete_Choices := Nb_Discrete_Choices; Choice := First (Choices (Assoc)); loop @@ -2058,10 +2062,9 @@ package body Sem_Aggr is elsif Nkind (A) /= N_Aggregate then if Is_Overloaded (A) then A_Type := Any_Type; - Get_First_Interp (A, I, It); + Get_First_Interp (A, I, It); while Present (It.Typ) loop - if Is_Tagged_Type (It.Typ) and then not Is_Limited_Type (It.Typ) then @@ -2555,7 +2558,7 @@ package body Sem_Aggr is if Is_Array_Type (Expr_Type) then declare - Index : Node_Id := First_Index (Expr_Type); + Index : Node_Id; -- Range of the current constrained index in the array Orig_Index : Node_Id := First_Index (Etype (Component)); @@ -2569,6 +2572,7 @@ package body Sem_Aggr is -- range checks. begin + Index := First_Index (Expr_Type); while Present (Index) loop if Depends_On_Discriminant (Orig_Index) then Apply_Range_Check (Index, Etype (Unconstr_Index)); @@ -2890,7 +2894,6 @@ package body Sem_Aggr is Parent_Typ := Base_Type (Typ); while Parent_Typ /= Root_Typ loop - Prepend_Elmt (Parent_Typ, To => Parent_Typ_List); Parent_Typ := Etype (Parent_Typ); @@ -3208,11 +3211,10 @@ package body Sem_Aggr is begin K := L; - while K /= U loop T := Case_Table (K + 1); - J := K + 1; + J := K + 1; while J /= L and then Expr_Value (Case_Table (J - 1).Choice_Lo) > Expr_Value (T.Choice_Lo)