diff options
| -rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/ada/sem_ch6.adb | 36 |
2 files changed, 25 insertions, 16 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 126c6d4..37e48db 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -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): diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 08a1bb9..39eecfb 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -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; |