rxada_0.1.1_dd9da799/src/bugs/b003_taskleak.adb

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
with Ada.Finalization;
with Ada.Unchecked_Deallocation;

procedure B003_Taskleak is

   package Inner is

      type Some_Task is task interface;
      type Some_Ptr is access all Some_Task'Class;

      type Wrapper (Ptr : Some_Ptr) is limited private;

      task type T is new Inner.Some_Task with end T;

   private

      type Wrapper (Ptr : Some_Ptr) is new Ada.Finalization.Limited_Controlled with null record;

      overriding procedure Initialize (W : in out Wrapper);

   end Inner;

   package body Inner is

      overriding procedure Initialize (W : in out Wrapper) is
         procedure Free is new Ada.Unchecked_Deallocation (Some_Task'Class, Some_Ptr);
         Ptr : Some_Ptr := W.Ptr;
      begin
         Free (Ptr);
      end Initialize;

      task body T is
         W : Inner.Wrapper (T'Unchecked_Access);
      begin
         delay 1.0;
      end T;

   end Inner;

   procedure Leak is
      Ptr : Inner.Some_Ptr := new Inner.T;
   begin
      null;
   end Leak;

begin
   for I in 1 .. 99 loop
      Leak;
   end loop;
end B003_Taskleak;