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

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 126c6d4bbb5004ce699fe737495234f2be6142bf..37e48dba4e68ed5828f938c416b0c9cb29924715 100644 (file)
--- 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 08a1bb975c21fc4c417f7bd30c1d0fc5cc6b0390..39eecfb76f04fd24ef3ffc0d0b199f54161f0d06 100644 (file)
--- 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;