From: Justin Squirek <squirek@adacore.com>
Date: Fri, 13 Jan 2017 11:06:54 +0000 (+0000)
Subject: sem_ch6.adb (Check_Aggregate_Accessibility): Ignore function calls in accessibility... 
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=996ce809cd29df96df27b7e7d75508fe2fe6fb93;p=gcc.git

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
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 126c6d4bbb5..37e48dba4e6 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 08a1bb975c2..39eecfb76f0 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;