Ed Schonberg <schonberg@adacore.com>
Javier Miranda <miranda@adacore.com>
* checks.adb (Null_Exclusion_Static_Checks): In the case of
N_Object_Declaration, only perform the checks if the Object_Definition
is not an Access_Definition.
* sem_ch3.adb (Access_Subprogram_Declaration): Add test for the case
where the parent of an the access definition is an N_Object_Declaration
when determining the Associated_Node_For_Itype and scope of an
anonymous access-to-subprogram type.
* exp_ch6.adb (Expand_N_Subprogram_Declaration): Set the
Corresponding_Spec on the body created for a null procedure. Add ???
comment. Remove New_Copy_Tree call on body argument to
Set_Body_To_Inline.
* exp_ch6.adb (Add_Simple_Call_By_Copy_Code): For an out parameter with
discriminants, use the type of the actual as well, because the
discriminants may be read by the called subprogram.
* sem_ch3.adb (Access_Type_Declaration): If the designated type is an
access type we do not need to handle non-limited views.
(Build_Derived_Record_Type): Additional check to check that in case of
private types, interfaces are only allowed in private extensions.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@101575
138bc75d-0d04-0410-961f-
82ee72b054a4
when N_Object_Declaration =>
Msg_K := Objects;
- Has_Null_Exclusion := Null_Exclusion_Present (N);
- Typ := Entity (Object_Definition (N));
- Related_Nod := Object_Definition (N);
- Check_Must_Be_Access (Typ, Has_Null_Exclusion);
- Check_Already_Null_Excluding_Type
- (Typ, Has_Null_Exclusion, Related_Nod);
- Check_Must_Be_Initialized (N, Related_Nod);
+
+ if Nkind (Object_Definition (N)) /= N_Access_Definition then
+ Has_Null_Exclusion := Null_Exclusion_Present (N);
+ Typ := Entity (Object_Definition (N));
+ Related_Nod := Object_Definition (N);
+ Check_Must_Be_Access (Typ, Has_Null_Exclusion);
+ Check_Already_Null_Excluding_Type
+ (Typ, Has_Null_Exclusion, Related_Nod);
+ Check_Must_Be_Initialized (N, Related_Nod);
+ end if;
+
Check_Null_Not_Allowed (N);
when N_Discriminant_Specification =>
Outcod := New_Copy_Tree (Incod);
-- Generate declaration of temporary variable, initializing it
- -- with the input parameter unless we have an OUT variable or
+ -- with the input parameter unless we have an OUT formal or
-- this is an initialization call.
+ -- If the formal is an out parameter with discriminants, the
+ -- discriminants must be captured even if the rest of the object
+ -- is in principle uninitialized, because the discriminants may
+ -- be read by the called subprogram.
+
if Ekind (Formal) = E_Out_Parameter then
Incod := Empty;
+ if Has_Discriminants (Etype (Formal)) then
+ Indic := New_Occurrence_Of (Etype (Actual), Loc);
+ end if;
+
elsif Inside_Init_Proc then
+
+ -- Could use a comment here to match comment below ???
+
if Nkind (Actual) /= N_Selected_Component
or else
not Has_Discriminant_Dependent_Constraint
then
Incod := Empty;
- else
- -- We need the component in order to generate the proper
- -- actual subtype, that depends on enclosing discriminants.
- -- What is the comment for, given code below is null ???
+ -- Otherwise, keep the component in order to generate the proper
+ -- actual subtype, that depends on enclosing discriminants.
+ else
null;
end if;
end if;
Make_Handled_Sequence_Of_Statements (Loc,
Statements => New_List (Make_Null_Statement (Loc))));
begin
- Set_Body_To_Inline (N, New_Copy_Tree (Bod));
+ Set_Body_To_Inline (N, Bod);
Insert_After (N, Bod);
Analyze (Bod);
+
+ -- Corresponding_Spec isn't being set by Analyze_Subprogram_Body,
+ -- evidently because Set_Has_Completion is called earlier for null
+ -- procedures in Analyze_Subprogram_Declaration, so we force its
+ -- setting here. If the setting of Has_Completion is not set
+ -- earlier, then it can result in missing body errors if other
+ -- errors were already reported (since expansion is turned off).
+
+ -- Should creation of the empty body be moved to the analyzer???
+
+ Set_Corresponding_Spec (Bod, Defining_Entity (Specification (N)));
end;
end if;
end Expand_N_Subprogram_Declaration;
while Nkind (D_Ityp) /= N_Full_Type_Declaration
and then Nkind (D_Ityp) /= N_Procedure_Specification
and then Nkind (D_Ityp) /= N_Function_Specification
+ and then Nkind (D_Ityp) /= N_Object_Declaration
and then Nkind (D_Ityp) /= N_Object_Renaming_Declaration
and then Nkind (D_Ityp) /= N_Formal_Type_Declaration
loop
Set_Scope (Desig_Type, Scope (Defining_Unit_Name (D_Ityp)));
elsif Nkind (D_Ityp) = N_Full_Type_Declaration
+ or else Nkind (D_Ityp) = N_Object_Declaration
or else Nkind (D_Ityp) = N_Object_Renaming_Declaration
or else Nkind (D_Ityp) = N_Formal_Type_Declaration
then
N_Desig : Entity_Id;
begin
- if From_With_Type (Desig) then
+ if From_With_Type (Desig)
+ and then Ekind (Desig) /= E_Access_Type
+ then
Set_From_With_Type (T);
if Ekind (Desig) = E_Incomplete_Type then
Same_Interfaces : Boolean := True;
begin
+ if Nkind (N_Partial) /= N_Private_Extension_Declaration then
+ Error_Msg_N
+ ("(Ada 2005) interfaces only allowed in private"
+ & " extension declarations", N_Partial);
+ end if;
+
-- Count the interfaces implemented by the partial view
- if not Is_Empty_List (Interface_List (N_Partial)) then
+ if Nkind (N_Partial) = N_Private_Extension_Declaration
+ and then not Is_Empty_List (Interface_List (N_Partial))
+ then
Iface_Partial := First (Interface_List (N_Partial));
while Present (Iface_Partial) loop