2015-05-26 Ed Schonberg <schonberg@adacore.com>

	* exp_aggr.adb (Build_Array_Aggr_Code, Gen_Assign):
	If a component is default-initialized and its type has an
	invariant procedure, insert an invariant test after code for
	default-initialization of the component.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@223664 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index ccdf46b54eaee0e73fd96cd161ddf3e4fb4179ba..da387055e6734b343545f17fc9171e9f2d508cb0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2015-05-26  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_aggr.adb (Build_Array_Aggr_Code, Gen_Assign):
+       If a component is default-initialized and its type has an
+       invariant procedure, insert an invariant test after code for
+       default-initialization of the component.
+
 2015-05-26  Gary Dismukes  <dismukes@adacore.com>
 
        * einfo.ads, sem_util.adb, sem_ch4.adb: Minor reformatting.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 8651074d4929263490aea5902d792567d123a9a5..3e2006338898916078a2068d3f0d9969414fabb0 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -1160,11 +1160,21 @@ package body Exp_Aggr is
                    Typ               => Ctype,
                    With_Default_Init => True));
 
+               --  If the component type has invariants, add an invariant
+               --  check after the component is default-initialized. It will
+               --  be analyzed and resolved before the code for initialization
+               --  of other components.
+
+               if Has_Invariants (Ctype) then
+                  Set_Etype (Indexed_Comp, Ctype);
+                  Append_To (L, Make_Invariant_Call (Indexed_Comp));
+               end if;
+
             elsif Is_Access_Type (Ctype) then
                Append_To (L,
-                  Make_Assignment_Statement (Loc,
-                    Name       => Indexed_Comp,
-                    Expression => Make_Null (Loc)));
+                 Make_Assignment_Statement (Loc,
+                   Name       => Indexed_Comp,
+                   Expression => Make_Null (Loc)));
             end if;
 
             if Needs_Finalization (Ctype) then
@@ -1392,7 +1402,7 @@ package body Exp_Aggr is
 
          L_Range :=
            Make_Range (Loc,
-             Low_Bound => L_L,
+             Low_Bound  => L_L,
              High_Bound => L_H);
 
          --  Construct "for L_J in Index_Base range L .. H"
@@ -1911,8 +1921,7 @@ package body Exp_Aggr is
                         return Duplicate_Subexpr (Expression (Assoc));
                      end if;
 
-                     Corresp_Disc :=
-                       Corresponding_Discriminant (Corresp_Disc);
+                     Corresp_Disc := Corresponding_Discriminant (Corresp_Disc);
                   end loop;
                end if;
 
@@ -1954,8 +1963,7 @@ package body Exp_Aggr is
                   while Present (Corresp_Disc)
                     and then Disc /= Corresp_Disc
                   loop
-                     Corresp_Disc :=
-                       Corresponding_Discriminant (Corresp_Disc);
+                     Corresp_Disc := Corresponding_Discriminant (Corresp_Disc);
                   end loop;
 
                   if Disc = Corresp_Disc then
@@ -1984,8 +1992,10 @@ package body Exp_Aggr is
 
                   if No (Assoc_Elmt) then
                      Next (Assoc);
+
                   else
                      Next_Elmt (Assoc_Elmt);
+
                      if Present (Assoc_Elmt) then
                         Assoc := Node (Assoc_Elmt);
                      else
@@ -2022,7 +2032,7 @@ package body Exp_Aggr is
 
             if Present (Disc_Value) then
                Cond := Make_Op_Ne (Loc,
-                 Left_Opnd =>
+                 Left_Opnd  =>
                    Make_Selected_Component (Loc,
                      Prefix        => New_Copy_Tree (Target),
                      Selector_Name => New_Occurrence_Of (Discr, Loc)),
@@ -2504,7 +2514,7 @@ package body Exp_Aggr is
                --  expansion, which was delayed.
 
                if Nkind_In (Unqualify (Ancestor), N_Aggregate,
-                                               N_Extension_Aggregate)
+                                                  N_Extension_Aggregate)
                then
                   Set_Analyzed (Ancestor, False);
                   Set_Analyzed (Expression (Ancestor), False);
@@ -2530,9 +2540,9 @@ package body Exp_Aggr is
                if Tagged_Type_Expansion then
                   Instr :=
                     Make_OK_Assignment_Statement (Loc,
-                      Name =>
+                      Name       =>
                         Make_Selected_Component (Loc,
-                          Prefix => New_Copy_Tree (Target),
+                          Prefix        => New_Copy_Tree (Target),
                           Selector_Name =>
                             New_Occurrence_Of
                               (First_Tag_Component (Base_Type (Typ)), Loc)),
@@ -2617,10 +2627,10 @@ package body Exp_Aggr is
                       Selector_Name => New_Occurrence_Of (Discriminant, Loc));
 
                   Discriminant_Value :=
-                    Get_Discriminant_Value (
-                      Discriminant,
-                      N_Typ,
-                      Discriminant_Constraint (N_Typ));
+                    Get_Discriminant_Value
+                      (Discriminant,
+                       N_Typ,
+                       Discriminant_Constraint (N_Typ));
 
                   Instr :=
                     Make_OK_Assignment_Statement (Loc,
@@ -2670,7 +2680,7 @@ package body Exp_Aggr is
                if Present (CPP_Init_Proc (T)) then
                   Append_To (L,
                     Make_Procedure_Call_Statement (Loc,
-                      New_Occurrence_Of (CPP_Init_Proc (T), Loc)));
+                      Name => New_Occurrence_Of (CPP_Init_Proc (T), Loc)));
                end if;
             end Invoke_IC_Proc;