From 58fda84daa95719faf5305ad44f09816d1de280a Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Thu, 31 Jul 2008 14:37:33 +0200 Subject: [PATCH] exp_aggr.adb (Aggr_Size_OK): If the aggregate has a single component and the context is an object... 2008-07-31 Ed Schonberg * exp_aggr.adb (Aggr_Size_OK): If the aggregate has a single component and the context is an object declaration with non-static bounds, treat the aggregate as non-static. From-SVN: r138393 --- gcc/ada/exp_aggr.adb | 49 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 45 insertions(+), 4 deletions(-) diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 40ff379..84aed96 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -28,6 +28,7 @@ with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; with Elists; use Elists; +with Errout; use Errout; with Expander; use Expander; with Exp_Util; use Exp_Util; with Exp_Ch3; use Exp_Ch3; @@ -169,12 +170,15 @@ package body Exp_Aggr is -- Local Subprograms for Array Aggregate Expansion -- ----------------------------------------------------- - function Aggr_Size_OK (Typ : Entity_Id) return Boolean; + function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean; -- Very large static aggregates present problems to the back-end, and -- are transformed into assignments and loops. This function verifies -- that the total number of components of an aggregate is acceptable -- for transformation into a purely positional static form. It is called -- prior to calling Flatten. + -- This function also detects and warns about one-component aggregates + -- that appear in a non-static context. Even if the component value is + -- static, such an aggregate must be expanded into an assignment. procedure Convert_Array_Aggr_In_Allocator (Decl : Node_Id; @@ -291,7 +295,7 @@ package body Exp_Aggr is -- Aggr_Size_OK -- ------------------ - function Aggr_Size_OK (Typ : Entity_Id) return Boolean is + function Aggr_Size_OK (N : Node_Id; Typ : Entity_Id) return Boolean is Lo : Node_Id; Hi : Node_Id; Indx : Node_Id; @@ -399,6 +403,43 @@ package body Exp_Aggr is return True; end if; + -- One-component aggregates are suspicious, and if the context + -- type is an object declaration with non-static bounds it will + -- trip gcc; such an aggregate must be expanded into a single + -- assignment. + + if Hiv = Lov + and then Nkind (Parent (N)) = N_Object_Declaration + then + declare + Index_Type : constant Entity_Id := + Etype + (First_Index + (Etype (Defining_Identifier (Parent (N))))); + Indx : Node_Id; + begin + if not Compile_Time_Known_Value (Type_Low_Bound (Index_Type)) + or else not Compile_Time_Known_Value + (Type_High_Bound (Index_Type)) + then + if Present (Component_Associations (N)) then + Indx := + First (Choices (First (Component_Associations (N)))); + if Is_Entity_Name (Indx) + and then not Is_Type (Entity (Indx)) + then + Error_Msg_N + ("single component aggregate in non-static context?", + Indx); + Error_Msg_N ("\maybe subtype name was meant?", Indx); + end if; + end if; + + return False; + end if; + end; + end if; + declare Rng : constant Uint := Hiv - Lov + 1; @@ -3847,7 +3888,7 @@ package body Exp_Aggr is -- assignments to the target anyway, but it is conceivable that -- it will eventually be able to treat such aggregates statically??? - if Aggr_Size_OK (Typ) + if Aggr_Size_OK (N, Typ) and then Flatten (N, First_Index (Typ), First_Index (Base_Type (Typ))) then if Static_Components then @@ -6383,7 +6424,7 @@ package body Exp_Aggr is elsif Nkind (Expression (Expr)) /= N_Integer_Literal then return False; - elsif not Aggr_Size_OK (Typ) then + elsif not Aggr_Size_OK (N, Typ) then return False; end if; -- 2.7.4