From mboxrd@z Thu Jan  1 00:00:00 1970
X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on polar.synack.me
X-Spam-Level: 
X-Spam-Status: No, score=-1.3 required=5.0 tests=BAYES_00,INVALID_MSGID
	autolearn=no autolearn_force=no version=3.4.4
X-Google-Language: ENGLISH,ASCII-7-bit
X-Google-Thread: 103376,899097ccdbca937b,start
X-Google-Attributes: gid103376,public
From: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
Subject: Finalization of record components which are tasks
Date: 2000/03/02
Message-ID: <tgr9dtixlk.fsf@mercury.rus.uni-stuttgart.de>#1/1
X-Deja-AN: 592139318
Sender: rusfw@mercury.rus.uni-stuttgart.de
Organization: Comp.Center (RUS), U of Stuttgart, FRG
Content-Type: text/plain; charset=us-ascii
User-Agent: Gnus/5.0804 (Gnus v5.8.4) Emacs/20.5
Mime-Version: 1.0
Newsgroups: comp.lang.ada
Date: 2000-03-02T00:00:00+00:00
List-Id: <comp.lang.ada>

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/