aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPiotr Trojanek <trojanek@adacore.com>2020-09-24 22:25:18 +0200
committerPierre-Marie de Rodat <derodat@adacore.com>2020-11-24 05:15:59 -0500
commit02fb12801b18c9d3cfe1c29b5be9f33d2dc77e21 (patch)
treef7279e63c49caf15cc4739f0446f7244b6875d82
parent2307a1aeb8ecaf0bac055a13d65eef884cbf22b3 (diff)
downloadgcc-02fb12801b18c9d3cfe1c29b5be9f33d2dc77e21.zip
gcc-02fb12801b18c9d3cfe1c29b5be9f33d2dc77e21.tar.gz
gcc-02fb12801b18c9d3cfe1c29b5be9f33d2dc77e21.tar.bz2
[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.
-rw-r--r--gcc/ada/exp_spark.adb126
-rw-r--r--gcc/ada/sem_aggr.adb15
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