From 02fb12801b18c9d3cfe1c29b5be9f33d2dc77e21 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 24 Sep 2020 22:25:18 +0200 Subject: [PATCH] [Ada] Remove SPARK-specific expansion of array aggregates gcc/ada/ * exp_spark.adb (Expand_SPARK_Array_Aggregate, Expand_SPARK_N_Aggregate): Remove, no longer needed. * sem_aggr.adb (Resolve_Iterated_Component_Association): Only remove references in the analyzed expression when generating code and the expression needs to be analyzed anew after being rewritten into a loop. --- gcc/ada/exp_spark.adb | 126 -------------------------------------------------- gcc/ada/sem_aggr.adb | 15 +++--- 2 files changed, 9 insertions(+), 132 deletions(-) diff --git a/gcc/ada/exp_spark.adb b/gcc/ada/exp_spark.adb index 75cdbe6..883a819 100644 --- a/gcc/ada/exp_spark.adb +++ b/gcc/ada/exp_spark.adb @@ -52,16 +52,6 @@ package body Exp_SPARK is -- Local Subprograms -- ----------------------- - procedure Expand_SPARK_Array_Aggregate (N : Node_Id; Index : Node_Id); - -- Perform array-aggregate-specific expansion of an array sub-aggregate N - -- corresponding to the Index of the outer-most aggregate. This routine - -- mimics Resolve_Array_Aggregate which only checks the aggregate for being - -- well-formed, but doesn't analyze nor apply range checks to - -- iterated_component_associations. - - procedure Expand_SPARK_N_Aggregate (N : Node_Id); - -- Perform aggregate-specific expansion - procedure Expand_SPARK_N_Attribute_Reference (N : Node_Id); -- Perform attribute-reference-specific expansion @@ -112,9 +102,6 @@ package body Exp_SPARK is => Qualify_Entity_Names (N); - when N_Aggregate => - Expand_SPARK_N_Aggregate (N); - -- Replace occurrences of System'To_Address by calls to -- System.Storage_Elements.To_Address. @@ -161,107 +148,6 @@ package body Exp_SPARK is end Expand_SPARK; ---------------------------------- - -- Expand_SPARK_Array_Aggregate -- - ---------------------------------- - - procedure Expand_SPARK_Array_Aggregate (N : Node_Id; Index : Node_Id) is - - procedure Expand_Aggr_Expr (Expr : Node_Id); - -- If Expr is a subaggregate, then process it recursively; otherwise it - -- is an expression for the array components which might not have been - -- analyzed and where scalar range checks could be missing. - - ---------------------- - -- Expand_Aggr_Expr -- - ---------------------- - - procedure Expand_Aggr_Expr (Expr : Node_Id) is - Nxt_Ind : constant Node_Id := Next_Index (Index); - begin - if Present (Nxt_Ind) then - Expand_SPARK_Array_Aggregate (Expr, Index => Nxt_Ind); - else - declare - Comp_Type : constant Entity_Id := Component_Type (Etype (N)); - begin - Analyze_And_Resolve (Expr, Comp_Type); - - if Is_Scalar_Type (Comp_Type) then - Apply_Scalar_Range_Check (Expr, Comp_Type); - end if; - end; - end if; - end Expand_Aggr_Expr; - - -- Local variables - - Assoc : Node_Id := First (Component_Associations (N)); - - -- Start of processing for Expand_SPARK_Array_Aggregate - - begin - while Present (Assoc) loop - -- For iterated_component_association we must apply range check to - -- discrete choices and re-analyze the expression, because frontend - -- only checks its legality and then analyzes the expanded loop code. - - if Nkind (Assoc) = N_Iterated_Component_Association then - declare - Choice : Node_Id; - begin - -- Analyze discrete choices - - Choice := First (Discrete_Choices (Assoc)); - - while Present (Choice) loop - - -- The index denotes a range of elements where range checks - -- have been already applied. - - if Nkind (Choice) in N_Others_Choice - | N_Range - | N_Subtype_Indication - then - null; - - -- Otherwise the index denotes a single element (or a - -- subtype name which doesn't require range checks). - - else pragma Assert (Nkind (Choice) in N_Subexpr); - Apply_Scalar_Range_Check (Choice, Etype (Index)); - end if; - - Next (Choice); - end loop; - - -- Keep processing the expression with index parameter in scope - - Push_Scope (Scope (Defining_Identifier (Assoc))); - Enter_Name (Defining_Identifier (Assoc)); - Expand_Aggr_Expr (Expression (Assoc)); - End_Scope; - end; - - -- For ordinary component associations we recurse into subaggregates, - -- because there could be nested iterated_component_association (and - -- it is harmless to analyze and apply checks if there is none). - - else pragma Assert (Nkind (Assoc) = N_Component_Association); - declare - Expr : constant Node_Id := Expression (Assoc); - pragma Assert (Present (Expr) xor Box_Present (Assoc)); - begin - if Present (Expr) then - Expand_Aggr_Expr (Expr); - end if; - end; - end if; - - Next (Assoc); - end loop; - end Expand_SPARK_Array_Aggregate; - - ---------------------------------- -- Expand_SPARK_Delta_Or_Update -- ---------------------------------- @@ -475,18 +361,6 @@ package body Exp_SPARK is end if; end Expand_SPARK_N_Freeze_Type; - ------------------------------ - -- Expand_SPARK_N_Aggregate -- - ------------------------------ - - procedure Expand_SPARK_N_Aggregate (N : Node_Id) is - Aggr_Typ : constant Entity_Id := Etype (N); - begin - if Is_Array_Type (Aggr_Typ) then - Expand_SPARK_Array_Aggregate (N, Index => First_Index (Aggr_Typ)); - end if; - end Expand_SPARK_N_Aggregate; - ---------------------------------------- -- Expand_SPARK_N_Attribute_Reference -- ---------------------------------------- diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb index 90ddee2..3f96139 100644 --- a/gcc/ada/sem_aggr.adb +++ b/gcc/ada/sem_aggr.adb @@ -1680,18 +1680,21 @@ package body Sem_Aggr is Set_Ekind (Id, E_Variable); Set_Scope (Id, Ent); - -- Analyze the expression without expansion, to verify legality. - -- After analysis we remove references to the index variable because - -- the expression will be analyzed anew when the enclosing aggregate - -- is expanded, and the construct is rewritten as a loop with a new - -- index variable. + -- Analyze expression without expansion, to verify legality. + -- When generating code, we then remove references to the index + -- variable, because the expression will be analyzed anew after + -- rewritting as a loop with a new index variable; when not + -- generating code we leave the analyzed expression as it is. Expr := Expression (N); Expander_Mode_Save_And_Set (False); Dummy := Resolve_Aggr_Expr (Expr, Single_Elmt => False); Expander_Mode_Restore; - Remove_References (Expr); + + if Operating_Mode /= Check_Semantics then + Remove_References (Expr); + end if; -- An iterated_component_association may appear in a nested -- aggregate for a multidimensional structure: preserve the bounds -- 2.7.4