[Ada] Remove SPARK-specific expansion of array aggregates
authorPiotr Trojanek <trojanek@adacore.com>
Thu, 24 Sep 2020 20:25:18 +0000 (22:25 +0200)
committerPierre-Marie de Rodat <derodat@adacore.com>
Tue, 24 Nov 2020 10:15:59 +0000 (05:15 -0500)
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
gcc/ada/sem_aggr.adb

index 75cdbe6..883a819 100644 (file)
@@ -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 --
    ----------------------------------------
index 90ddee2..3f96139 100644 (file)
@@ -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