Patchwork [Ada] Crash processing nested aggregate in constant declaration

login
register
mail settings
Submitter Arnaud Charlet
Date Aug. 29, 2011, 1:55 p.m.
Message ID <20110829135520.GA21542@adacore.com>
Download mbox | patch
Permalink /patch/112058/
State New
Headers show

Comments

Arnaud Charlet - Aug. 29, 2011, 1:55 p.m.
The compiler may crash processing a constant object declaration whose
expression is a nested aggregate. After this patch the following test
compiles without errors.

package Test_Nested_Aggregate is
   type T_Comp (Validity : Boolean := False) is record
      null;
   end record;

   type T_Root is abstract tagged record
     Comp_1 : Natural;
     Comp_2 : T_Comp;
   end record;

   type T_Deriv is new T_Root with record
      null;
   end record;

   K_Value : constant T_Deriv :=
     (Comp_1 => 0,
      Comp_2 => (Validity => false) );

   procedure Dummy;
end;

package body Test_Nested_Aggregate is
  procedure Dummy is begin null; end;
end;

Command: gcc -c test_nested_aggregate.adb

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-29  Javier Miranda  <miranda@adacore.com>

	* exp_aggr.adb (Expand_Record_Aggregate): Use the top-level enclosing
	aggregate to take a consistent decision on the need to convert into
	assignments aggregates that initialize constant objects.

Patch

Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb	(revision 178156)
+++ exp_aggr.adb	(working copy)
@@ -5099,6 +5099,16 @@ 
       --  semantics of Ada complicate the analysis and lead to anomalies in
       --  the gcc back-end if the aggregate is not expanded into assignments.
 
+      function Has_Visible_Private_Ancestor (Id : E) return Boolean;
+      --  If any ancestor of the current type is private, the aggregate
+      --  cannot be built in place. We canot rely on Has_Private_Ancestor,
+      --  because it will not be set when type and its parent are in the
+      --  same scope, and the parent component needs expansion.
+
+      function Top_Level_Aggregate (N : Node_Id) return Node_Id;
+      --  For nested aggregates return the ultimate enclosing aggregate; for
+      --  non-nested aggregates return N.
+
       ----------------------------------
       -- Component_Not_OK_For_Backend --
       ----------------------------------
@@ -5178,18 +5188,6 @@ 
          return False;
       end Component_Not_OK_For_Backend;
 
-      --  Remaining Expand_Record_Aggregate variables
-
-      Tag_Value : Node_Id;
-      Comp      : Entity_Id;
-      New_Comp  : Node_Id;
-
-      function Has_Visible_Private_Ancestor (Id : E) return Boolean;
-      --  If any ancestor of the current type is private, the aggregate
-      --  cannot be built in place. We canot rely on Has_Private_Ancestor,
-      --  because it will not be set when type and its parent are in the
-      --  same scope, and the parent component needs expansion.
-
       -----------------------------------
       --  Has_Visible_Private_Ancestor --
       -----------------------------------
@@ -5197,6 +5195,7 @@ 
       function Has_Visible_Private_Ancestor (Id : E) return Boolean is
          R  : constant Entity_Id := Root_Type (Id);
          T1 : Entity_Id := Id;
+
       begin
          loop
             if Is_Private_Type (T1) then
@@ -5211,6 +5210,31 @@ 
          end loop;
       end Has_Visible_Private_Ancestor;
 
+      -------------------------
+      -- Top_Level_Aggregate --
+      -------------------------
+
+      function Top_Level_Aggregate (N : Node_Id) return Node_Id is
+         Aggr : Node_Id := N;
+
+      begin
+         while Present (Parent (Aggr))
+           and then Nkind_In (Parent (Aggr), N_Component_Association,
+                                             N_Aggregate)
+         loop
+            Aggr := Parent (Aggr);
+         end loop;
+
+         return Aggr;
+      end Top_Level_Aggregate;
+
+      --  Local variables
+
+      Top_Level_Aggr : constant Node_Id := Top_Level_Aggregate (N);
+      Tag_Value      : Node_Id;
+      Comp           : Entity_Id;
+      New_Comp       : Node_Id;
+
    --  Start of processing for Expand_Record_Aggregate
 
    begin
@@ -5317,8 +5341,8 @@ 
 
       elsif Has_Mutable_Components (Typ)
         and then
-          (Nkind (Parent (N)) /= N_Object_Declaration
-            or else not Constant_Present (Parent (N)))
+          (Nkind (Parent (Top_Level_Aggr)) /= N_Object_Declaration
+            or else not Constant_Present (Parent (Top_Level_Aggr)))
       then
          Convert_To_Assignments (N, Typ);