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
This commit is contained in:
parent
f145ece721
commit
e83ed69230
|
@ -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>
|
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:
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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,15 +4746,20 @@ 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);
|
||||||
|
@ -4764,6 +4769,15 @@ package body Exp_Ch9 is
|
||||||
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
|
||||||
|
@ -4778,7 +4792,8 @@ package body Exp_Ch9 is
|
||||||
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
|
||||||
|
@ -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
|
||||||
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;
|
||||||
|
@ -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
|
||||||
-- 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)
|
||||||
|
|
Loading…
Reference in New Issue