[Ada] Unnesting: handle the semantic of Storage_Pool field

2018-07-16  Ed Schonberg  <schonberg@adacore.com>

gcc/ada/

	* exp_unst.adb (Visit_Node): Handle the semantic of Storage_Pool field
	in relevant nodes: Allocate, Free, and return statements.

From-SVN: r262725

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 3dd8c84d1d5713f0b91c2d5b4b7c45763fa8538e..13428e986ba2851bd9fc6cea380344cc17b1f727 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2018-07-16  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_unst.adb (Visit_Node): Handle the semantic of Storage_Pool field
+       in relevant nodes: Allocate, Free, and return statements.
+
 2018-07-16  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_ch12.adb (Analyze_Package_Instantiation): Handle properly an

diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 9a2a482f32c343025d33f6b087761fc080727827..464eaa036f8f5ade9d3e425eed4f8f9ddbf3796d 100644 (file)
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -812,7 +812,7 @@ package body Exp_Unst is
 
                --  Similarly, the following constructs include a semantic
                --  attribute Procedure_To_Call that must be handled like
-               --  other calls.
+               --  other calls. Likewise for attribute Storage_Pool.
 
                when N_Allocator
                   | N_Extended_Return_Statement
@@ -820,7 +820,9 @@ package body Exp_Unst is
                   | N_Simple_Return_Statement
                =>
                   declare
+                     Pool : constant Entity_Id := Storage_Pool (N);
                      Proc : constant Entity_Id := Procedure_To_Call (N);
+
                   begin
                      if Present (Proc)
                        and then Scope_Within (Proc, Subp)
@@ -828,6 +830,18 @@ package body Exp_Unst is
                      then
                         Append_Unique_Call ((N, Current_Subprogram, Proc));
                      end if;
+
+                     if Present (Pool)
+                       and then not Is_Library_Level_Entity (Pool)
+                       and then Scope_Within_Or_Same (Scope (Pool), Subp)
+                     then
+                        Caller := Current_Subprogram;
+                        Callee := Enclosing_Subprogram (Pool);
+
+                        if Callee /= Caller then
+                           Note_Uplevel_Ref (Pool, Empty, Caller, Callee);
+                        end if;
+                     end if;
                   end;
 
                   --  For an allocator with a qualified expression, check type