exp_ch9.adb (Build_Simple_Entry_Call): Set_Is_Internal on the temporary object used...

2015-10-16  Gary Dismukes  <dismukes@adacore.com>

	* exp_ch9.adb (Build_Simple_Entry_Call): Set_Is_Internal on
	the temporary object used for a by-copy entry parameter, to
	ensure that the object doesn't get its No_Initialization flag
	reset later in Default_Initialize_Object. Also, generate the
	assignment of the actual to the temporary in the additional case
	of a scalar out parameter whose type has a Default_Value aspect.
	* exp_ch3.adb: Fix minor typo in comment.

From-SVN: r228879

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3c949fccc1f39bda243746b10a53c51b6e85a2bd..c016f670596de945b56b9c43825ec4f54ba58ed1 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,13 @@
+2015-10-16  Gary Dismukes  <dismukes@adacore.com>
+
+       * exp_ch9.adb (Build_Simple_Entry_Call): Set_Is_Internal on
+       the temporary object used for a by-copy entry parameter, to
+       ensure that the object doesn't get its No_Initialization flag
+       reset later in Default_Initialize_Object. Also, generate the
+       assignment of the actual to the temporary in the additional case
+       of a scalar out parameter whose type has a Default_Value aspect.
+       * exp_ch3.adb: Fix minor typo in comment.
+
 2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>
 
        * exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb:

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index 8f8b6d741b23d572f44525d9b3b3f5687c007a18..bddb6e402c7d055b3bf5346309185dcb0bc910c1 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -5154,7 +5154,7 @@ package body Exp_Ch3 is
 
          --  Provide a default value if the object needs simple initialization
          --  and does not already have an initial value. A generated temporary
-         --  do not require initialization because it will be assigned later.
+         --  does not require initialization because it will be assigned later.
 
          elsif Needs_Simple_Initialization
                  (Typ, Initialize_Scalars

diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb
index 4c6962cddb5c0e729660bdf1a010031b7f4298a1..5d1635171d9a346a845c300637e556a5625950d0 100644 (file)
--- a/gcc/ada/exp_ch9.adb
+++ b/gcc/ada/exp_ch9.adb
@@ -4729,7 +4729,7 @@ package body Exp_Ch9 is
             Formal := First_Formal (Ent);
             while Present (Actual) loop
 
-               --  If it is a by_copy_type, copy it to a new variable. The
+               --  If it is a by-copy type, copy it to a new variable. The
                --  packaged record has a field that points to this variable.
 
                if Is_By_Copy_Type (Etype (Actual)) then
@@ -4746,24 +4746,38 @@ package body Exp_Ch9 is
 
                   Set_No_Initialization (N_Node);
 
-                  --  We must make an assignment statement separate for the
-                  --  case of limited type. We cannot assign it unless the
+                  --  We must make a separate assignment statement for the
+                  --  case of limited types. We cannot assign it unless the
                   --  Assignment_OK flag is set first. An out formal of an
-                  --  access type must also be initialized from the actual,
-                  --  as stated in RM 6.4.1 (13), but no constraint is applied
-                  --  before the call.
+                  --  access type or whose type has a Default_Value must also
+                  --  be initialized from the actual (see RM 6.4.1 (13-13.1)),
+                  --  but no constraint, predicate, or null-exclusion check is
+                  --  applied before the call.
 
                   if Ekind (Formal) /= E_Out_Parameter
                     or else Is_Access_Type (Etype (Formal))
+                    or else
+                      (Is_Scalar_Type (Etype (Formal))
+                        and then
+                         Present (Default_Aspect_Value (Etype (Formal))))
                   then
                      N_Var :=
                        New_Occurrence_Of (Defining_Identifier (N_Node), Loc);
                      Set_Assignment_OK (N_Var);
                      Append_To (Stats,
                        Make_Assignment_Statement (Loc,
-                         Name => N_Var,
+                         Name       => N_Var,
                          Expression => Relocate_Node (Actual)));
 
+                     --  Mark the object as internal, so we don't later reset
+                     --  No_Initialization flag in Default_Initialize_Object,
+                     --  which would lead to needless default initialization.
+                     --  We don't set this outside the if statement, because
+                     --  out scalar parameters without Default_Value do require
+                     --  default initialization if Initialize_Scalars applies.
+
+                     Set_Is_Internal (Defining_Identifier (N_Node));
+
                      --  If actual is an out parameter of a null-excluding
                      --  access type, there is access check on entry, so set
                      --  Suppress_Assignment_Checks on the generated statement
@@ -4777,8 +4791,9 @@ package body Exp_Ch9 is
                   Append_To (Plist,
                     Make_Attribute_Reference (Loc,
                       Attribute_Name => Name_Unchecked_Access,
-                    Prefix =>
-                      New_Occurrence_Of (Defining_Identifier (N_Node), Loc)));
+                      Prefix         =>
+                        New_Occurrence_Of
+                          (Defining_Identifier (N_Node), Loc)));
 
                else
                   --  Interface class-wide formal
@@ -4800,7 +4815,7 @@ package body Exp_Ch9 is
                        Make_Reference (Loc,
                          Unchecked_Convert_To (Iface_Typ,
                            Make_Selected_Component (Loc,
-                             Prefix =>
+                             Prefix        =>
                                Relocate_Node (Actual),
                              Selector_Name =>
                                New_Occurrence_Of (Iface_Tag, Loc)))));
@@ -4832,7 +4847,7 @@ package body Exp_Ch9 is
 
             Parm3 :=
               Make_Attribute_Reference (Loc,
-                Prefix => New_Occurrence_Of (P, Loc),
+                Prefix         => New_Occurrence_Of (P, Loc),
                 Attribute_Name => Name_Address);
 
             Append (Pdecl, Decls);
@@ -4896,8 +4911,9 @@ package body Exp_Ch9 is
 
                   Call :=
                     Make_Procedure_Call_Statement (Loc,
-                      Name => New_Occurrence_Of (
-                        RTE (RE_Protected_Single_Entry_Call), Loc),
+                      Name                   =>
+                        New_Occurrence_Of
+                          (RTE (RE_Protected_Single_Entry_Call), Loc),
 
                       Parameter_Associations => New_List (
                         Make_Attribute_Reference (Loc,
@@ -4914,7 +4930,8 @@ package body Exp_Ch9 is
          else
             Call :=
               Make_Procedure_Call_Statement (Loc,
-                Name => New_Occurrence_Of (RTE (RE_Call_Simple), Loc),
+                Name                   =>
+                  New_Occurrence_Of (RTE (RE_Call_Simple), Loc),
                 Parameter_Associations => New_List (Parm1, Parm2, Parm3));
 
          end if;
@@ -4935,11 +4952,11 @@ package body Exp_Ch9 is
                then
                   N_Node :=
                     Make_Assignment_Statement (Loc,
-                      Name => New_Copy (Actual),
+                      Name       => New_Copy (Actual),
                       Expression =>
                         Make_Explicit_Dereference (Loc,
                           Make_Selected_Component (Loc,
-                            Prefix => New_Occurrence_Of (P, Loc),
+                            Prefix        => New_Occurrence_Of (P, Loc),
                             Selector_Name =>
                               Make_Identifier (Loc, Chars (Formal)))));
 
@@ -5037,7 +5054,7 @@ package body Exp_Ch9 is
 
          Call :=
            Make_Procedure_Call_Statement (Loc,
-             Name => Name,
+             Name                   => Name,
              Parameter_Associations =>
                New_List (Make_Attribute_Reference (Loc,
                  Prefix         => New_Occurrence_Of (Chain, Loc),
@@ -5320,7 +5337,7 @@ package body Exp_Ch9 is
             declare
                Bas : Entity_Id :=
                        Base_Type
-                        (Etype (Discrete_Subtype_Definition (Parent (Efam))));
+                         (Etype (Discrete_Subtype_Definition (Parent (Efam))));
 
                Bas_Decl : Node_Id := Empty;
                Lo, Hi   : Node_Id;
@@ -5590,10 +5607,8 @@ package body Exp_Ch9 is
       else
          if Is_Protected_Type (Ntyp) then
             Sel := Name_uObject;
-
          elsif Is_Task_Type (Ntyp) then
             Sel := Name_uTask_Id;
-
          else
             raise Program_Error;
          end if;
@@ -5764,7 +5779,6 @@ package body Exp_Ch9 is
       --  Now add lengths of preceding entries and entry families
 
       Prev := First_Entity (Ttyp);
-
       while Chars (Prev) /= Chars (Ent)
         or else (Ekind (Prev) /= Ekind (Ent))
         or else not Sem_Ch6.Type_Conformant (Ent, Prev)