sem_res.adb (Resolve_Allocator): Warning on allocation of tasks on a subpool and rewrite the allocator into a...

2011-12-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Resolve_Allocator): Warning on allocation
	of tasks on a subpool and rewrite the allocator into a raise
	Program_Error statement.
	* s-stposu.ads, s-stposu.adb: Code reformatting.
	(Create_Subpool): Remove formal parameter Storage_Size.
	(Default_Subpool_For_Pool): Add the default implementation of this
	routine.
	(Set_Pool_Of_Subpool): Rename formal parameter Pool to To. Update
	all the uses of the parameter.

From-SVN: r182533

1 files changed, 20 insertions, 24 deletions

diff --git a/gcc/ada/s-stposu.ads b/gcc/ada/s-stposu.ads
index 38f8cfc..d5819ca 100644
--- a/gcc/ada/s-stposu.ads
+++ b/gcc/ada/s-stposu.ads
@@ -38,7 +38,7 @@ with System.Finalization_Masters;
 with System.Storage_Elements;
 
 package System.Storage_Pools.Subpools is
-   pragma Preelaborate;
+   pragma Preelaborate (Subpools);
 
    type Root_Storage_Pool_With_Subpools is abstract
      new Root_Storage_Pool with private;
@@ -70,21 +70,16 @@ package System.Storage_Pools.Subpools is
       Storage_Address          : out System.Address;
       Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
       Alignment                : System.Storage_Elements.Storage_Count;
-      Subpool                  : not null Subpool_Handle)
-   is abstract;
+      Subpool                  : not null Subpool_Handle) is abstract;
 
    --  ??? This precondition causes errors in simple tests, disabled for now
 
---     with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
+--      with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
    --  This routine requires implementation. Allocate an object described by
    --  Size_In_Storage_Elements and Alignment on a subpool.
 
-   function Create_Subpool
-     (Pool         : in out Root_Storage_Pool_With_Subpools;
-      Storage_Size : Storage_Elements.Storage_Count :=
-                     Storage_Elements.Storage_Count'Last)
-   return not null Subpool_Handle
-   is abstract;
+   function Create_Subpool (Pool : in out Root_Storage_Pool_With_Subpools)
+     return not null Subpool_Handle is abstract;
    --  This routine requires implementation. Create a subpool within the given
    --  pool_with_subpools.
 
@@ -93,39 +88,40 @@ package System.Storage_Pools.Subpools is
       Storage_Address          : System.Address;
       Size_In_Storage_Elements : System.Storage_Elements.Storage_Count;
       Alignment                : System.Storage_Elements.Storage_Count)
-   is null;
+      is null;
 
    procedure Deallocate_Subpool
      (Pool    : in out Root_Storage_Pool_With_Subpools;
-      Subpool : in out Subpool_Handle)
-   is abstract;
+      Subpool : in out Subpool_Handle) is abstract;
 
    --  ??? This precondition causes errors in simple tests, disabled for now
 
---     with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
+--      with Pre'Class => Pool_Of_Subpool (Subpool) = Pool'Access;
    --  This routine requires implementation. Reclaim the storage a particular
    --  subpool occupies in a pool_with_subpools. This routine is called by
    --  Ada.Unchecked_Deallocate_Subpool.
 
    function Default_Subpool_For_Pool
-     (Pool : Root_Storage_Pool_With_Subpools)
-   return not null Subpool_Handle
-   is abstract;
-   --  This routine requires implementation. Returns a common subpool used for
-   --  allocations without Subpool_Handle_name in the allocator.
-
-   function Pool_Of_Subpool
-     (Subpool : not null Subpool_Handle)
-   return access Root_Storage_Pool_With_Subpools'Class;
+     (Pool : Root_Storage_Pool_With_Subpools) return not null Subpool_Handle;
+   --  Return a common subpool which is used for object allocations without a
+   --  Subpool_Handle_name in the allocator. The default implementation of this
+   --  routine raises Program_Error.
+
+   function Pool_Of_Subpool (Subpool : not null Subpool_Handle)
+     return access Root_Storage_Pool_With_Subpools'Class;
    --  Return the owner of the subpool
 
    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);
    --  Set the owner of the subpool. This is intended to be called from
    --  Create_Subpool or similar subpool constructors. Raises Program_Error
    --  if the subpool already belongs to a pool.
 
+   overriding function Storage_Size (Pool : Root_Storage_Pool_With_Subpools)
+     return System.Storage_Elements.Storage_Count is
+       (System.Storage_Elements.Storage_Count'Last);
+
 private
    --  Model
    --             Pool_With_Subpools     SP_Node    SP_Node    SP_Node