Finalization of record components which are tasks

[Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>]

Does the termination of a task which is a component of a controlled
object really happen *before* the user-defined finalization subprogram
is called?  This is really surprising.  IMHO, both common sense and
7.6.1(5) suggest that the task object has to be finalized *after* the
user-defined finalization subprogram has completed.

The program below illustrates the problem.  Running it with GNAT (on
Solaris, Debian GNU/Linux, Red Hat 6.1) results in the following
output:

Before Task_Type.Start (R)
Before Start
After Task_Type.Start (R)
Before Wait
Watcher object finalized
Task has terminated
Before Wait in finalization
Exception in Finalize
Exception name: TASKING_ERROR
Message: s-tasren.adb:516

"Watcher object finalized" means that the task object is about to be
finalized; and in fact, the task has already terminated when Finalize
on the composite type is called.  Very strange.

with Ada.Exceptions, Ada.Finalization;
with Ada.Text_IO;
with Task_Type;
procedure Free_Task is

   procedure Create_Task is
      R : Task_Type.Some_Record;
   begin
      Ada.Text_IO.Put_Line ("Before Task_Type.Start (R)");
      Task_Type.Start (R);
      Ada.Text_IO.Put_Line ("After Task_Type.Start (R)");
    end Create_Task;

begin
   Create_Task;
end Free_Task;

with Ada.Exceptions;
with Ada.Text_IO;
package body Task_Type is

   procedure Finalize (Object : in out Some_Record) is
   begin
      if Object.T'Terminated then
         Ada.Text_IO.Put_Line ("Task has terminated");
      else
         Ada.Text_IO.Put_Line ("Task has NOT terminated");
      end if;
      Ada.Text_IO.Put_Line ("Before Wait in finalization");
      Object.T.Wait;
      Ada.Text_IO.Put_Line ("After Wait in finalization");
   exception
      when E : others =>
         Ada.Text_IO.Put_Line ("Exception in Finalize");
         Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
   end Finalize;

   type Watcher is new Ada.Finalization.Limited_Controlled with null record;

   procedure Finalize (Object : in out Watcher) is
   begin
      Ada.Text_IO.Put_Line ("Watcher object finalized");
   end Finalize;

   task body Some_Task is
      W : Watcher;
   begin
      Ada.Text_IO.Put_Line ("Before Start");
      accept Start;
      Ada.Text_IO.Put_Line ("Before Wait");
      select
         accept Wait;
         Ada.Text_IO.Put_Line ("After Wait");
      or
         terminate;
      end select;
   exception
      when E : others =>
         Ada.Text_IO.Put_Line ("Exception in task");
         Ada.Text_IO.Put_Line (Ada.Exceptions.Exception_Information (E));
   end Some_Task;

   procedure Start (R : in out Some_Record) is
   begin
      R.T.Start;
   end Start;

   procedure Wait (R : in out Some_Record) is
   begin
      R.T.Wait;
   end Wait;

end Task_Type;

with Ada.Finalization;
package Task_Type is

   type Some_Record is limited private;

   procedure Start (R : in out Some_Record);
   procedure Wait (R : in out Some_Record);

private

   task type Some_Task (Reference : access Some_Record) is
      entry Start;
      entry Wait;
   end Some_Task;

   type Some_Record is new Ada.Finalization.Limited_Controlled with record
      T : Some_Task (Some_Record'Access);
   end record;

   procedure Finalize (Object : in out Some_Record);

end Task_Type;

-- 
Florian Weimer 	                  Florian.Weimer@RUS.Uni-Stuttgart.DE
RUS-CERT, Univ. Stuttgart         http://cert.uni-stuttgart.de/