Commit 996ce809 by Justin Squirek Committed by Arnaud Charlet

sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function calls in…

sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function calls in accessibility check on return statement.

2017-01-13  Justin Squirek  <squirek@adacore.com>

	* sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function
	calls in accessibility check on return statement.

From-SVN: r244422
parent 36be0082
2017-01-13 Justin Squirek <squirek@adacore.com>
* sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function
calls in accessibility check on return statement.
2017-01-13 Hristian Kirtchev <kirtchev@adacore.com> 2017-01-13 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper): * sem_ch6.adb (Analyze_Subprogram_Body_Helper):
......
...@@ -663,11 +663,11 @@ package body Sem_Ch6 is ...@@ -663,11 +663,11 @@ package body Sem_Ch6 is
----------------------------------- -----------------------------------
procedure Check_Aggregate_Accessibility (Aggr : Node_Id) is procedure Check_Aggregate_Accessibility (Aggr : Node_Id) is
Typ : constant Entity_Id := Etype (Aggr); Typ : constant Entity_Id := Etype (Aggr);
Assoc : Node_Id; Assoc : Node_Id;
Discr : Entity_Id; Discr : Entity_Id;
Expr : Node_Id; Expr : Node_Id;
Obj : Node_Id; Obj : Node_Id;
begin begin
if Is_Record_Type (Typ) and then Has_Discriminants (Typ) then if Is_Record_Type (Typ) and then Has_Discriminants (Typ) then
...@@ -676,6 +676,7 @@ package body Sem_Ch6 is ...@@ -676,6 +676,7 @@ package body Sem_Ch6 is
while Present (Discr) loop while Present (Discr) loop
if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
Expr := Expression (Assoc); Expr := Expression (Assoc);
if Nkind (Expr) = N_Attribute_Reference if Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) /= Name_Unrestricted_Access and then Attribute_Name (Expr) /= Name_Unrestricted_Access
then then
...@@ -686,21 +687,24 @@ package body Sem_Ch6 is ...@@ -686,21 +687,24 @@ package body Sem_Ch6 is
Obj := Prefix (Obj); Obj := Prefix (Obj);
end loop; end loop;
-- No check needed for an aliased formal. -- Do not check aliased formals or function calls. A
-- A run-time check may still be needed ??? -- run-time check may still be needed ???
if Is_Entity_Name (Obj) if Is_Entity_Name (Obj)
and then Is_Formal (Entity (Obj)) and then Comes_From_Source (Obj)
and then Is_Aliased (Entity (Obj))
then then
null; if Is_Formal (Entity (Obj))
and then Is_Aliased (Entity (Obj))
then
null;
elsif Object_Access_Level (Obj) > elsif Object_Access_Level (Obj) >
Scope_Depth (Scope (Scope_Id)) Scope_Depth (Scope (Scope_Id))
then then
Error_Msg_N Error_Msg_N
("access discriminant in return aggregate would be " ("access discriminant in return aggregate would "
& "a dangling reference", Obj); & "be a dangling reference", Obj);
end if;
end if; end if;
end if; end if;
end if; end if;
......
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