From 5ed4ba1574be5f1f1b01672d38cbcb76c6951398 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 16 Jun 2016 12:23:06 +0200 Subject: [PATCH] [multiple changes] 2016-06-16 Justin Squirek * sem_ch3.adb (Analyze_Object_Declaration): Add a missing check for optimized aggregate arrays with qualified expressions. * exp_aggr.adb (Expand_Array_Aggregate): Fix block and conditional statement in charge of deciding whether to perform in-place expansion. Specifically, use Parent_Node to jump over the qualified expression to the object declaration node. Also, a check has been inserted to skip the optimization if SPARK 2005 is being used in strict adherence to RM 4.3(5). 2016-06-16 Tristan Gingold * sem_prag.adb (Analyze_Pragma): Simplify code for Pragma_Priority. From-SVN: r237514 --- gcc/ada/ChangeLog | 16 ++++++++++++++++ gcc/ada/exp_aggr.adb | 24 ++++++++++++++---------- gcc/ada/sem_ch3.adb | 7 +++++-- gcc/ada/sem_prag.adb | 25 +++++++++---------------- 4 files changed, 44 insertions(+), 28 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index d9239fff946..dc34b75a7e4 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,19 @@ +2016-06-16 Justin Squirek + + * sem_ch3.adb (Analyze_Object_Declaration): Add a missing check + for optimized aggregate arrays with qualified expressions. + * exp_aggr.adb (Expand_Array_Aggregate): Fix block and + conditional statement in charge of deciding whether to perform + in-place expansion. Specifically, use Parent_Node to jump over + the qualified expression to the object declaration node. Also, + a check has been inserted to skip the optimization if SPARK 2005 + is being used in strict adherence to RM 4.3(5). + +2016-06-16 Tristan Gingold + + * sem_prag.adb (Analyze_Pragma): Simplify code + for Pragma_Priority. + 2016-06-16 Eric Botcazou * sem_util.ads (Indexed_Component_Bit_Offset): Declare. diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb index 19ecdad9745..c75cafc778a 100644 --- a/gcc/ada/exp_aggr.adb +++ b/gcc/ada/exp_aggr.adb @@ -5433,8 +5433,8 @@ package body Exp_Aggr is -- STEP 3 - -- Delay expansion for nested aggregates: it will be taken care of - -- when the parent aggregate is expanded. + -- Delay expansion for nested aggregates: it will be taken care of when + -- the parent aggregate is expanded. Parent_Node := Parent (N); Parent_Kind := Nkind (Parent_Node); @@ -5524,14 +5524,18 @@ package body Exp_Aggr is and then Parent_Kind = N_Object_Declaration and then not Must_Slide (Etype (Defining_Identifier (Parent_Node)), Typ) - and then N = Expression (Parent_Node) - and then not Is_Bit_Packed_Array (Typ) + and then Present (Expression (Parent_Node)) and then not Has_Controlled_Component (Typ) + and then not Is_Bit_Packed_Array (Typ) + + -- ??? the test for SPARK 05 needs documentation + + and then not Restriction_Check_Required (SPARK_05) then In_Place_Assign_OK_For_Declaration := True; - Tmp := Defining_Identifier (Parent (N)); - Set_No_Initialization (Parent (N)); - Set_Expression (Parent (N), Empty); + Tmp := Defining_Identifier (Parent_Node); + Set_No_Initialization (Parent_Node); + Set_Expression (Parent_Node, Empty); -- Set kind and type of the entity, for use in the analysis -- of the subsequent assignments. If the nominal type is not @@ -5544,10 +5548,10 @@ package body Exp_Aggr is if not Is_Constrained (Typ) then Build_Constrained_Type (Positional => False); - elsif Is_Entity_Name (Object_Definition (Parent (N))) - and then Is_Constrained (Entity (Object_Definition (Parent (N)))) + elsif Is_Entity_Name (Object_Definition (Parent_Node)) + and then Is_Constrained (Entity (Object_Definition (Parent_Node))) then - Set_Etype (Tmp, Entity (Object_Definition (Parent (N)))); + Set_Etype (Tmp, Entity (Object_Definition (Parent_Node))); else Set_Size_Known_At_Compile_Time (Typ, False); diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index 4e5b8f7f9ae..22b4721d552 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -3471,7 +3471,7 @@ package body Sem_Ch3 is -- In case of aggregates we must also take care of the correct -- initialization of nested aggregates bug this is done at the - -- point of the analysis of the aggregate (see sem_aggr.adb). + -- point of the analysis of the aggregate (see sem_aggr.adb) ??? if Present (Expression (N)) and then Nkind (Expression (N)) = N_Aggregate @@ -4038,7 +4038,10 @@ package body Sem_Ch3 is elsif Is_Array_Type (T) and then No_Initialization (N) - and then Nkind (Original_Node (E)) = N_Aggregate + and then (Nkind (Original_Node (E)) = N_Aggregate + or else (Nkind (Original_Node (E)) = N_Qualified_Expression + and then Nkind (Original_Node (Expression + (Original_Node (E)))) = N_Aggregate)) then if not Is_Entity_Name (Object_Definition (N)) then Act_T := Etype (E); diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index c798929b71c..86086a7fa6f 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -18903,22 +18903,15 @@ package body Sem_Prag is -- where we ignore the value if out of range. else - declare - Val : constant Uint := Expr_Value (Arg); - begin - if not Relaxed_RM_Semantics - and then - (Val < 0 - or else Val > Expr_Value (Expression - (Parent (RTE (RE_Max_Priority))))) - then - Error_Pragma_Arg - ("main subprogram priority is out of range", Arg1); - else - Set_Main_Priority - (Current_Sem_Unit, UI_To_Int (Expr_Value (Arg))); - end if; - end; + if not Relaxed_RM_Semantics + and then not Is_In_Range (Arg, RTE (RE_Priority)) + then + Error_Pragma_Arg + ("main subprogram priority is out of range", Arg1); + else + Set_Main_Priority + (Current_Sem_Unit, UI_To_Int (Expr_Value (Arg))); + end if; end if; -- Load an arbitrary entity from System.Tasking.Stages or -- 2.30.2