mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-14 05:30:25 +08:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
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
This commit is contained in:
Justin Squirek 2017-01-13 11:06:54 +00:00 committed by Arnaud Charlet
parent 36be008200
commit 996ce809cd
2 changed files with 25 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
gcc/ada/ChangeLog
View File

@ -1,3 +1,8 @@
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>
* sem_ch6.adb (Analyze_Subprogram_Body_Helper):

36
gcc/ada/sem_ch6.adb
View File

@ -663,11 +663,11 @@ package body Sem_Ch6 is
-----------------------------------
procedure Check_Aggregate_Accessibility (Aggr : Node_Id) is
Typ : constant Entity_Id := Etype (Aggr);
Assoc : Node_Id;
Discr : Entity_Id;
Expr : Node_Id;
Obj : Node_Id;
Typ : constant Entity_Id := Etype (Aggr);
Assoc : Node_Id;
Discr : Entity_Id;
Expr : Node_Id;
Obj : Node_Id;
begin
if Is_Record_Type (Typ) and then Has_Discriminants (Typ) then
@ -676,6 +676,7 @@ package body Sem_Ch6 is
while Present (Discr) loop
if Ekind (Etype (Discr)) = E_Anonymous_Access_Type then
Expr := Expression (Assoc);
if Nkind (Expr) = N_Attribute_Reference
and then Attribute_Name (Expr) /= Name_Unrestricted_Access
then
@ -686,21 +687,24 @@ package body Sem_Ch6 is
Obj := Prefix (Obj);
end loop;
-- No check needed for an aliased formal.
-- A run-time check may still be needed ???
-- Do not check aliased formals or function calls. A
-- run-time check may still be needed ???
if Is_Entity_Name (Obj)
and then Is_Formal (Entity (Obj))
and then Is_Aliased (Entity (Obj))
and then Comes_From_Source (Obj)
then
null;
if Is_Formal (Entity (Obj))
and then Is_Aliased (Entity (Obj))
then
null;
elsif Object_Access_Level (Obj) >
Scope_Depth (Scope (Scope_Id))
then
Error_Msg_N
("access discriminant in return aggregate would be "
& "a dangling reference", Obj);
elsif Object_Access_Level (Obj) >
Scope_Depth (Scope (Scope_Id))
then
Error_Msg_N
("access discriminant in return aggregate would "
& "be a dangling reference", Obj);
end if;
end if;
end if;
end if;