Skip to content

R
riscv-gcc-1
Commit e83ed692 by Gary Dismukes Committed by Arnaud Charlet
Options

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

exp_ch9.adb (Build_Simple_Entry_Call): Set_Is_Internal on the temporary object used for a by-copy entry parameter...

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
parent f145ece7
Showing with 46 additions and 22 deletions
gcc/ada/ChangeLog
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> 2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb: * exp_util.adb, sem_util.ads, sem_ch6.adb, sem_ch7.adb, sem_ch8.adb:
......
gcc/ada/exp_ch3.adb
...@@ -5154,7 +5154,7 @@ package body Exp_Ch3 is ...@@ -5154,7 +5154,7 @@ package body Exp_Ch3 is
-- Provide a default value if the object needs simple initialization -- Provide a default value if the object needs simple initialization
-- and does not already have an initial value. A generated temporary -- 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 elsif Needs_Simple_Initialization
(Typ, Initialize_Scalars (Typ, Initialize_Scalars
......
gcc/ada/exp_ch9.adb
...@@ -4729,7 +4729,7 @@ package body Exp_Ch9 is ...@@ -4729,7 +4729,7 @@ package body Exp_Ch9 is
Formal := First_Formal (Ent); Formal := First_Formal (Ent);
while Present (Actual) loop 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. -- packaged record has a field that points to this variable.
if Is_By_Copy_Type (Etype (Actual)) then if Is_By_Copy_Type (Etype (Actual)) then
...@@ -4746,24 +4746,38 @@ package body Exp_Ch9 is ...@@ -4746,24 +4746,38 @@ package body Exp_Ch9 is
Set_No_Initialization (N_Node); Set_No_Initialization (N_Node);
-- We must make an assignment statement separate for the -- We must make a separate assignment statement for the
-- case of limited type. We cannot assign it unless the -- case of limited types. We cannot assign it unless the
-- Assignment_OK flag is set first. An out formal of an -- Assignment_OK flag is set first. An out formal of an
-- access type must also be initialized from the actual, -- access type or whose type has a Default_Value must also
-- as stated in RM 6.4.1 (13), but no constraint is applied -- be initialized from the actual (see RM 6.4.1 (13-13.1)),
-- before the call. -- but no constraint, predicate, or null-exclusion check is
-- applied before the call.
if Ekind (Formal) /= E_Out_Parameter if Ekind (Formal) /= E_Out_Parameter
or else Is_Access_Type (Etype (Formal)) or else Is_Access_Type (Etype (Formal))
or else
(Is_Scalar_Type (Etype (Formal))
and then
Present (Default_Aspect_Value (Etype (Formal))))
then then
N_Var := N_Var :=
New_Occurrence_Of (Defining_Identifier (N_Node), Loc); New_Occurrence_Of (Defining_Identifier (N_Node), Loc);
Set_Assignment_OK (N_Var); Set_Assignment_OK (N_Var);
Append_To (Stats, Append_To (Stats,
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => N_Var, Name => N_Var,
Expression => Relocate_Node (Actual))); 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 -- If actual is an out parameter of a null-excluding
-- access type, there is access check on entry, so set -- access type, there is access check on entry, so set
-- Suppress_Assignment_Checks on the generated statement -- Suppress_Assignment_Checks on the generated statement
...@@ -4777,8 +4791,9 @@ package body Exp_Ch9 is ...@@ -4777,8 +4791,9 @@ package body Exp_Ch9 is
Append_To (Plist, Append_To (Plist,
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Attribute_Name => Name_Unchecked_Access, Attribute_Name => Name_Unchecked_Access,
Prefix => Prefix =>
New_Occurrence_Of (Defining_Identifier (N_Node), Loc))); New_Occurrence_Of
(Defining_Identifier (N_Node), Loc)));
else else
-- Interface class-wide formal -- Interface class-wide formal
...@@ -4800,7 +4815,7 @@ package body Exp_Ch9 is ...@@ -4800,7 +4815,7 @@ package body Exp_Ch9 is
Make_Reference (Loc, Make_Reference (Loc,
Unchecked_Convert_To (Iface_Typ, Unchecked_Convert_To (Iface_Typ,
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix =>
Relocate_Node (Actual), Relocate_Node (Actual),
Selector_Name => Selector_Name =>
New_Occurrence_Of (Iface_Tag, Loc))))); New_Occurrence_Of (Iface_Tag, Loc)))));
...@@ -4832,7 +4847,7 @@ package body Exp_Ch9 is ...@@ -4832,7 +4847,7 @@ package body Exp_Ch9 is
Parm3 := Parm3 :=
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (P, Loc), Prefix => New_Occurrence_Of (P, Loc),
Attribute_Name => Name_Address); Attribute_Name => Name_Address);
Append (Pdecl, Decls); Append (Pdecl, Decls);
...@@ -4896,8 +4911,9 @@ package body Exp_Ch9 is ...@@ -4896,8 +4911,9 @@ package body Exp_Ch9 is
Call := Call :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of ( Name =>
RTE (RE_Protected_Single_Entry_Call), Loc), New_Occurrence_Of
(RTE (RE_Protected_Single_Entry_Call), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
...@@ -4914,7 +4930,8 @@ package body Exp_Ch9 is ...@@ -4914,7 +4930,8 @@ package body Exp_Ch9 is
else else
Call := Call :=
Make_Procedure_Call_Statement (Loc, 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)); Parameter_Associations => New_List (Parm1, Parm2, Parm3));
end if; end if;
...@@ -4935,11 +4952,11 @@ package body Exp_Ch9 is ...@@ -4935,11 +4952,11 @@ package body Exp_Ch9 is
then then
N_Node := N_Node :=
Make_Assignment_Statement (Loc, Make_Assignment_Statement (Loc,
Name => New_Copy (Actual), Name => New_Copy (Actual),
Expression => Expression =>
Make_Explicit_Dereference (Loc, Make_Explicit_Dereference (Loc,
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => New_Occurrence_Of (P, Loc), Prefix => New_Occurrence_Of (P, Loc),
Selector_Name => Selector_Name =>
Make_Identifier (Loc, Chars (Formal))))); Make_Identifier (Loc, Chars (Formal)))));
...@@ -5037,7 +5054,7 @@ package body Exp_Ch9 is ...@@ -5037,7 +5054,7 @@ package body Exp_Ch9 is
Call := Call :=
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => Name, Name => Name,
Parameter_Associations => Parameter_Associations =>
New_List (Make_Attribute_Reference (Loc, New_List (Make_Attribute_Reference (Loc,
Prefix => New_Occurrence_Of (Chain, Loc), Prefix => New_Occurrence_Of (Chain, Loc),
...@@ -5320,7 +5337,7 @@ package body Exp_Ch9 is ...@@ -5320,7 +5337,7 @@ package body Exp_Ch9 is
declare declare
Bas : Entity_Id := Bas : Entity_Id :=
Base_Type Base_Type
(Etype (Discrete_Subtype_Definition (Parent (Efam)))); (Etype (Discrete_Subtype_Definition (Parent (Efam))));
Bas_Decl : Node_Id := Empty; Bas_Decl : Node_Id := Empty;
Lo, Hi : Node_Id; Lo, Hi : Node_Id;
...@@ -5590,10 +5607,8 @@ package body Exp_Ch9 is ...@@ -5590,10 +5607,8 @@ package body Exp_Ch9 is
else else
if Is_Protected_Type (Ntyp) then if Is_Protected_Type (Ntyp) then
Sel := Name_uObject; Sel := Name_uObject;
elsif Is_Task_Type (Ntyp) then elsif Is_Task_Type (Ntyp) then
Sel := Name_uTask_Id; Sel := Name_uTask_Id;
else else
raise Program_Error; raise Program_Error;
end if; end if;
...@@ -5764,7 +5779,6 @@ package body Exp_Ch9 is ...@@ -5764,7 +5779,6 @@ package body Exp_Ch9 is
-- Now add lengths of preceding entries and entry families -- Now add lengths of preceding entries and entry families
Prev := First_Entity (Ttyp); Prev := First_Entity (Ttyp);
while Chars (Prev) /= Chars (Ent) while Chars (Prev) /= Chars (Ent)
or else (Ekind (Prev) /= Ekind (Ent)) or else (Ekind (Prev) /= Ekind (Ent))
or else not Sem_Ch6.Type_Conformant (Ent, Prev) or else not Sem_Ch6.Type_Conformant (Ent, Prev)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment