[Ada] Missing deallocation of subpool

[Arnaud Charlet <charlet at adacore dot com>]

This patch ensures that Deallocate_Subpool is invoked on each subpool when the
owner pool_with_subpools is finalized.

------------
-- Source --
------------

--  gc_spool.ads

with System.Storage_Pools.Subpools;
private with System.Storage_Elements;

package GC_SPool is
   use System;
   use System.Storage_Pools.Subpools;

   type Store is new Root_Storage_Pool_With_Subpools with private;
   subtype Substore_Handle is System.Storage_Pools.Subpools.Subpool_Handle;

   overriding function Create_Subpool
     (Pool : in out Store) return not null Substore_Handle;
   overriding procedure Deallocate_Subpool
     (Pool    : in out Store;
      Subpool : in out Substore_Handle);

private
   use System.Storage_Elements;

   type Substore is new Root_Subpool with null record;
   type Substore_Access is access all Substore;

   type Store is new Root_Storage_Pool_With_Subpools with record
      Default, S : Substore_Access;
   end record;

   overriding procedure Initialize (Pool : in out Store);
   overriding procedure Allocate_From_Subpool
     (Pool            : in out Store;
      Storage_Address : out System.Address;
      Size            : Storage_Count;
      Alignment       : Storage_Count;
      Subpool         : not null Substore_Handle);
   overriding function Default_Subpool_For_Pool
     (Pool : Store) return not null Substore_Handle;
end GC_SPool;

--  gc_spool.adb

with Ada.Text_IO;

package body GC_SPool is
   use Ada;
   type Handle is access all Storage_Array;

   overriding procedure Initialize (Pool : in out Store) is
   begin
      Text_IO.Put_Line ("Initialize");
      Pool.Default := new Substore;
      Storage_Pools.Subpools.Set_Pool_Of_Subpool
        (Subpool_Handle (Pool.Default), Pool);

      Pool.S := new Substore;
   end Initialize;

   overriding procedure Allocate_From_Subpool
     (Pool            : in out Store;
      Storage_Address : out System.Address;
      Size            : Storage_Count;
      Alignment       : Storage_Count;
      Subpool         : not null Substore_Handle)
   is
      H : Handle := new Storage_Array (1 .. Size);
   begin
      Text_IO.Put_Line ("Allocate from subpool : " & Size'Img);
      Storage_Address := H (1)'Address;
   end Allocate_From_Subpool;

   overriding function Create_Subpool
     (Pool : in out Store) return not null Substore_Handle
   is
      S : Substore_Handle := Pool.S.all'Unchecked_Access;
   begin
      Text_IO.Put_Line ("Create subpool");
      Storage_Pools.Subpools.Set_Pool_Of_Subpool (S, Pool);
      return S;
   end Create_Subpool;

   overriding procedure Deallocate_Subpool
     (Pool    : in out Store;
      Subpool : in out Substore_Handle) is
   begin
      Text_IO.Put_Line ("Deallocate subpool");
   end Deallocate_Subpool;

   overriding function Default_Subpool_For_Pool
     (Pool : Store) return not null Substore_Handle is
   begin
      Text_IO.Put_Line ("Default subpool for pool");
      return Pool.Default.all'Unchecked_Access;
   end Default_Subpool_For_Pool;
end GC_SPool;

--  tpool.adb

with Ada.Text_IO;
with GC_SPool;

procedure Tpool is
   use Ada;
   pragma Default_Storage_Pool (null);

   package Pool renames GC_SPool;
   GCP : Pool.Store;

   type R is record
      A, B, C : Integer;
   end record;

   type AR is access all R;
   for AR'Storage_Pool use GCP;

   GCSP : Pool.Substore_Handle := Pool.Create_Subpool (GCP);
   O1 : AR := new (GCSP) R'(8, 7, 8);

begin
   Text_IO.Put_Line ("Start Tpool");
end Tpool;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q -gnat12 tpool.adb
$ ./tpool
Initialize
Create subpool
Allocate from subpool :  12
Start Tpool
Deallocate subpool
Deallocate subpool

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-10-05  Hristian Kirtchev  <kirtchev@adacore.com>

	* s-spsufi.adb: Add with clause for Ada.Unchecked_Deallocation.
	Add with and use clauses for System.Finalization_Masters.
	(Finalize_And_Deallocate): Add an instance of
	Ada.Unchecked_Deallocation. Merge the code from the now obsolete
	Finalize_Subpool into this routine.
	* s-spsufi.ads: Add pragma Preelaborate.
	* s-stposu.adb: Remove with clause for
	Ada.Unchecked_Deallocation; Add with and use clauses for
	System.Storage_Pools.Subpools.Finalization; (Finalize_Pool):
	Update the comment on all actions takes with respect to a subpool
	finalization. Finalize and deallocate each individual subpool.
	(Finalize_Subpool): Removed.
	(Free): Removed;
	(Detach): Move from package body to spec.
	* s-stposu.ads (Detach): Move from package body to spec.
	(Finalize_Subpool): Removed.

Attachment: difs
Description: Text document