1. private with Recycling_Pools; 
  2.  
  3. package Pool_Testing is 
  4.  
  5.     type Car is abstract tagged private; 
  6.     type A_Car is access all Car'Class; 
  7.  
  8.     procedure Drive( this : access Car ); 
  9.  
  10.     procedure Delete( this : in out A_Car ); 
  11.  
  12.     procedure Destroy( this : access Car ) is abstract; 
  13.  
  14.     ---------------------------------------------------------------------------- 
  15.  
  16.     type Audi is new Car with private; 
  17.     type A_Audi is access all Audi'Class; 
  18.  
  19.     function Create_Audi return A_Audi; 
  20.  
  21.     ---------------------------------------------------------------------------- 
  22.  
  23.     procedure Go; 
  24.  
  25. private 
  26.  
  27.     use Recycling_Pools; 
  28.  
  29.     type Car is abstract tagged 
  30.         record 
  31.             topSpeed : Integer := 0; 
  32.         end record; 
  33.  
  34.     procedure Construct( this     : access Car; 
  35.                          topSpeed : Integer ); 
  36.  
  37.     procedure Destruct( this : access Car ); 
  38.  
  39.     ---------------------------------------------------------------------------- 
  40.  
  41.     audi_pool : Recycling_Pool; 
  42.     for A_Audi'Storage_Pool use audi_pool; 
  43.  
  44.     type Audi is new Car with 
  45.         record 
  46.             tipTronic : Boolean := True; 
  47.         end record; 
  48.  
  49.     procedure Construct( this      : access Audi; 
  50.                          topSpeed  : Integer; 
  51.                          tipTronic : Boolean ); 
  52.  
  53.     procedure Drive( this : access Audi ); 
  54.  
  55.     procedure Destruct( this : access Audi ); 
  56.  
  57.     procedure Destroy( this : access Audi ); 
  58.  
  59. end Pool_Testing;