From patchwork Wed Apr 24 14:57:04 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 239223 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id 4F91F2C00F3 for ; Thu, 25 Apr 2013 00:57:24 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; q=dns; s=default; b=UlUS0Uscsn5ORylnFNAXK3zRZOZmcCxzzi8DvtJ6CqVBqzSGLx suqoVAcYI4evgi5YiI5wbd8UG9282pzwV+B4qgAqfDOSIeqhYDnfyLtQSkGgi5CO SQcRKLJ3VZ3RuodkkZh4lUJ8WFw6Rd8QFOiUJAhAjn+PMsli9dnec1NfI= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:date :from:to:cc:subject:message-id:mime-version:content-type; s= default; bh=9IkHypfQR4PCAGvFy9GP0meCseI=; b=s/Js6faAFO58CbBrhp6W didP3P61CttoKmavPXMMIsBefIX4louWw5KMPmecjxb85pdftupVQNSQHHCtkIvo gOPt9nbQ1F/A5xqZfE5J9Im0lJAELRG7xAYWMHLJbPt0u/P0YKbyxO1YmPH2Q56v 9wlymJQ//CB3KN69i1S14qM= Received: (qmail 10276 invoked by alias); 24 Apr 2013 14:57:08 -0000 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org Received: (qmail 10253 invoked by uid 89); 24 Apr 2013 14:57:07 -0000 X-Spam-SWARE-Status: No, score=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO autolearn=ham version=3.3.1 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Wed, 24 Apr 2013 14:57:06 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 135812ED0C; Wed, 24 Apr 2013 10:57:05 -0400 (EDT) Received: from rock.gnat.com ([127.0.0.1]) by localhost (rock.gnat.com [127.0.0.1]) (amavisd-new, port 10024) with LMTP id 8B-hyJNy0QeQ; Wed, 24 Apr 2013 10:57:05 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id D63CA2EB8D; Wed, 24 Apr 2013 10:57:04 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id D51653FF09; Wed, 24 Apr 2013 10:57:04 -0400 (EDT) Date: Wed, 24 Apr 2013 10:57:04 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Jose Ruiz Subject: [Ada] Fall-back termination handlers does not apply to Self Message-ID: <20130424145704.GA1130@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) X-Virus-Found: No 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 * 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. 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;