sem_res.adb (Resolve_Allocator): Warning on allocation of tasks on a subpool and...

[gcc.git] / gcc / ada / s-stposu.adb

diff --git a/gcc/ada/s-stposu.adb b/gcc/ada/s-stposu.adb
index 78958412ab297adb55f85aade7131e6d545316c3..53f65cb2f37a0cef86f5a8adec588b79ad9f159e 100644 (file)
--- a/gcc/ada/s-stposu.adb
+++ b/gcc/ada/s-stposu.adb
@@ -431,6 +431,19 @@ package body System.Storage_Pools.Subpools is
       Deallocate (Pool, N_Addr, N_Size, Alignment);
    end Deallocate_Any_Controlled;
 
+   ------------------------------
+   -- Default_Subpool_For_Pool --
+   ------------------------------
+
+   function Default_Subpool_For_Pool
+     (Pool : Root_Storage_Pool_With_Subpools) return not null Subpool_Handle
+   is
+   begin
+      raise Program_Error;
+
+      return Pool.Subpools.Subpool;
+   end Default_Subpool_For_Pool;
+
    ------------
    -- Detach --
    ------------
@@ -607,7 +620,8 @@ package body System.Storage_Pools.Subpools is
    ---------------------
 
    function Pool_Of_Subpool (Subpool : not null Subpool_Handle)
-     return access Root_Storage_Pool_With_Subpools'Class is
+     return access Root_Storage_Pool_With_Subpools'Class
+   is
    begin
       return Subpool.Owner;
    end Pool_Of_Subpool;
@@ -762,7 +776,7 @@ package body System.Storage_Pools.Subpools is
 
    procedure Set_Pool_Of_Subpool
      (Subpool : not null Subpool_Handle;
-      Pool    : in out Root_Storage_Pool_With_Subpools'Class)
+      To      : in out Root_Storage_Pool_With_Subpools'Class)
    is
       N_Ptr : SP_Node_Ptr;
 
@@ -777,12 +791,12 @@ package body System.Storage_Pools.Subpools is
       --  Prevent the creation of a new subpool while the owner is being
       --  finalized. This is a serious error.
 
-      if Pool.Finalization_Started then
+      if To.Finalization_Started then
          raise Program_Error
            with "subpool creation after finalization started";
       end if;
 
-      Subpool.Owner := Pool'Unchecked_Access;
+      Subpool.Owner := To'Unchecked_Access;
 
       --  Create a subpool node and decorate it. Since this node is not
       --  allocated on the owner's pool, it must be explicitly destroyed by
@@ -792,7 +806,7 @@ package body System.Storage_Pools.Subpools is
       N_Ptr.Subpool := Subpool;
       Subpool.Node := N_Ptr;
 
-      Attach (N_Ptr, Pool.Subpools'Unchecked_Access);
+      Attach (N_Ptr, To.Subpools'Unchecked_Access);
 
       --  Mark the subpool's master as being a heterogeneous collection of
       --  controlled objects.