diff mbox

[Ada] Fall-back termination handlers does not apply to Self

Message ID 20130424145704.GA1130@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet April 24, 2013, 2:57 p.m. UTC 
This patch fixes a small missunderstanding in the implementation of fall-back
termination handlers. Previously, a fall-back termination handler set by a
given task would apply for itself. However, it has been now corrected because
it applies only to dependent tasks (see ARM C.7.3 par. 9/2).

The following test case must generate only a "OK: expected handler" message,
corresponding to the termination of the Child task triggering the fall-back
termination handler set by its creator (and not the one set by task Child).

$ gnatmake -q -gnat05 terminate_hierarchy
$ terminate_hierarchy
OK: expected handler

-----

with Ada.Task_Termination; use Ada.Task_Termination;
with Tasking;              use Tasking;

procedure Terminate_Hierarchy is
begin
   Set_Dependents_Fallback_Handler (Monitor.Parent_Handler'Access);
   Child.Start;
end Terminate_Hierarchy;

with Ada.Task_Identification; use Ada.Task_Identification;
with Ada.Task_Termination;    use Ada.Task_Termination;
with Ada.Exceptions;          use Ada.Exceptions;

package Tasking is
   protected Monitor is
      procedure Parent_Handler
        (C  : Cause_Of_Termination;
         Id : Task_Id;
         X  : Exception_Occurrence := Null_Occurrence);

      procedure Child_Handler
        (C  : Cause_Of_Termination;
         Id : Task_Id;
         X  : Exception_Occurrence := Null_Occurrence);
   end Monitor;

   task Child is
      entry Start;
   end Child;
end Tasking;

with Ada.Text_IO; use Ada.Text_IO;

package body Tasking is

   protected body Monitor is
      procedure Parent_Handler
        (C  : Cause_Of_Termination;
         Id : Task_Id;
         X  : Exception_Occurrence := Null_Occurrence) is
      begin
         Put_Line ("OK: expected handler");
      end Parent_Handler;

      procedure Child_Handler
        (C  : Cause_Of_Termination;
         Id : Task_Id;
         X  : Exception_Occurrence := Null_Occurrence) is
      begin
         Put_Line ("KO: unexpected handler");
      end Child_Handler;
   end Monitor;

   task body Child is
   begin
      Set_Dependents_Fallback_Handler (Monitor.Child_Handler'Access);
      accept Start;
   end Child;

end Tasking;

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

2013-04-24  Jose Ruiz  <ruiz@adacore.com>

	* s-tassta.adb, s-tarest.adb (Task_Wrapper): Start looking for
	fall-back termination handlers from the parents, because they apply
	only to dependent tasks.
	* s-solita.adb (Task_Termination_Handler_T): Do not look for fall-back
	termination handlers because the environment task has no parent,
	and if it defines one of these handlers it does not apply to
	itself because they apply only to dependent tasks.
diff mbox

Patch

Index: s-tassta.adb
===================================================================
--- s-tassta.adb	(revision 198221)
+++ s-tassta.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1992-2012, Free Software Foundation, Inc.          --
+--         Copyright (C) 1992-2013, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -1075,7 +1075,7 @@ 
       procedure Search_Fall_Back_Handler (ID : Task_Id);
       --  Procedure that searches recursively a fall-back handler through the
       --  master relationship. If the handler is found, its pointer is stored
-      --  in TH.
+      --  in TH. It stops when the handler is found or when the ID is null.
 
       ------------------------------
       -- Search_Fall_Back_Handler --
@@ -1083,21 +1083,22 @@ 
 
       procedure Search_Fall_Back_Handler (ID : Task_Id) is
       begin
+         --  A null Task_Id indicates that we have reached the root of the
+         --  task hierarchy and no handler has been found.
+
+         if ID = null then
+            return;
+
          --  If there is a fall back handler, store its pointer for later
          --  execution.
 
-         if ID.Common.Fall_Back_Handler /= null then
+         elsif ID.Common.Fall_Back_Handler /= null then
             TH := ID.Common.Fall_Back_Handler;
 
          --  Otherwise look for a fall back handler in the parent
 
-         elsif ID.Common.Parent /= null then
+         else
             Search_Fall_Back_Handler (ID.Common.Parent);
-
-         --  Otherwise, do nothing
-
-         else
-            return;
          end if;
       end Search_Fall_Back_Handler;
 
@@ -1331,9 +1332,12 @@ 
          TH := Self_ID.Common.Specific_Handler;
       else
          --  Look for a fall-back handler following the master relationship
-         --  for the task.
+         --  for the task. As specified in ARM C.7.3 par. 9/2, "the fall-back
+         --  handler applies only to the dependent tasks of the task". Hence,
+         --  if the terminating tasks (Self_ID) had a fall-back handler, it
+         --  would not apply to itself, so we start the search with the parent.
 
-         Search_Fall_Back_Handler (Self_ID);
+         Search_Fall_Back_Handler (Self_ID.Common.Parent);
       end if;
 
       Unlock (Self_ID);
Index: s-tarest.adb
===================================================================
--- s-tarest.adb	(revision 198221)
+++ s-tarest.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                  B o d y                                 --
 --                                                                          --
---         Copyright (C) 1999-2012, Free Software Foundation, Inc.          --
+--         Copyright (C) 1999-2013, Free Software Foundation, Inc.          --
 --                                                                          --
 -- GNARL is free software; you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -268,49 +268,45 @@ 
             Save_Occurrence (EO, E);
       end;
 
-      --  Look for a fall-back handler. It can be either in the task itself
-      --  or in the environment task. Note that this code is always executed
-      --  by a task whose master is the environment task. The task termination
-      --  code for the environment task is executed by
-      --  SSL.Task_Termination_Handler.
+      --  Look for a fall-back handler.
 
       --  This package is part of the restricted run time which supports
       --  neither task hierarchies (No_Task_Hierarchy) nor specific task
       --  termination handlers (No_Specific_Termination_Handlers).
 
-      --  There is no need for explicit protection against race conditions
-      --  for Self_ID.Common.Fall_Back_Handler because this procedure can
-      --  only be executed by Self, and the Fall_Back_Handler can only be
-      --  modified by Self.
+      --  As specified in ARM C.7.3 par. 9/2, "the fall-back handler applies
+      --  only to the dependent tasks of the task". Hence, if the terminating
+      --  tasks (Self_ID) had a fall-back handler, it would not apply to
+      --  itself. This code is always executed by a task whose master is the
+      --  environment task (the task termination code for the environment task
+      --  is executed by SSL.Task_Termination_Handler), so the fall-back
+      --  handler to execute for this task can only be defined by its parent
+      --  (there is no grandparent).
 
-      if Self_ID.Common.Fall_Back_Handler /= null then
-         Self_ID.Common.Fall_Back_Handler (Cause, Self_ID, EO);
-      else
-         declare
-            TH : Termination_Handler := null;
+      declare
+         TH : Termination_Handler := null;
 
-         begin
-            if Single_Lock then
-               Lock_RTS;
-            end if;
+      begin
+         if Single_Lock then
+            Lock_RTS;
+         end if;
 
-            Write_Lock (Self_ID.Common.Parent);
+         Write_Lock (Self_ID.Common.Parent);
 
-            TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
+         TH := Self_ID.Common.Parent.Common.Fall_Back_Handler;
 
-            Unlock (Self_ID.Common.Parent);
+         Unlock (Self_ID.Common.Parent);
 
-            if Single_Lock then
-               Unlock_RTS;
-            end if;
+         if Single_Lock then
+            Unlock_RTS;
+         end if;
 
-            --  Execute the task termination handler if we found it
+         --  Execute the task termination handler if we found it
 
-            if TH /= null then
-               TH.all (Cause, Self_ID, EO);
-            end if;
-         end;
-      end if;
+         if TH /= null then
+            TH.all (Cause, Self_ID, EO);
+         end if;
+      end;
 
       Terminate_Task (Self_ID);
    end Task_Wrapper;
Index: s-solita.adb
===================================================================
--- s-solita.adb	(revision 198221)
+++ s-solita.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2013, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -181,12 +181,13 @@ 
 
       --  There is no need for explicit protection against race conditions for
       --  this part because it can only be executed by the environment task
-      --  after all the other tasks have been finalized.
+      --  after all the other tasks have been finalized. Note that there is no
+      --  fall-back handler which could apply to this environment task because
+      --  it has no parents, and, as specified in ARM C.7.3 par. 9/2, "the
+      --  fall-back handler applies only to the dependent tasks of the task".
 
       if Self_Id.Common.Specific_Handler /= null then
          Self_Id.Common.Specific_Handler.all (Cause, Self_Id, EO);
-      elsif Self_Id.Common.Fall_Back_Handler /= null then
-         Self_Id.Common.Fall_Back_Handler.all (Cause, Self_Id, EO);
       end if;
    end Task_Termination_Handler_T;