* [Ada] Improper initialization of elementary parameters in entry calls
@ 2015-10-16 12:27 Arnaud Charlet
0 siblings, 0 replies; only message in thread
From: Arnaud Charlet @ 2015-10-16 12:27 UTC (permalink / raw)
To: gcc-patches; +Cc: Gary Dismukes
[-- Attachment #1: Type: text/plain, Size: 1225 bytes --]
The compiler was incorrectly default initializing entry call parameters in
cases where the parameter is of an access type or of a scalar type whose
Default_Value aspect is set. The access type case caused a problem for
CodePeer in the case where the formal parameter is a null-excluding access
type, because the compiler was initializing the null-excluding parameter
temporary to null. In case of a scalar out parameter with Default_Value,
the compiler was default-initializing the parameter temporary rather than
assigning the value of the actual to the temporary. The assignment of
the actual is now generated in the Default_Value case, and the default
initialization is suppressed in both cases.
Tested on x86_64-pc-linux-gnu, committed on trunk
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.
[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 7625 bytes --]
Index: exp_ch3.adb
===================================================================
--- exp_ch3.adb (revision 228874)
+++ exp_ch3.adb (working copy)
@@ -5154,7 +5154,7 @@
-- 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
Index: exp_ch9.adb
===================================================================
--- exp_ch9.adb (revision 228874)
+++ exp_ch9.adb (working copy)
@@ -4729,7 +4729,7 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
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 @@
-- 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)
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2015-10-16 12:22 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2015-10-16 12:27 [Ada] Improper initialization of elementary parameters in entry calls Arnaud Charlet
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).