From patchwork Thu Oct 13 10:17:49 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 119401 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]) by ozlabs.org (Postfix) with SMTP id 44465B6F89 for ; Thu, 13 Oct 2011 21:18:32 +1100 (EST) Received: (qmail 26741 invoked by alias); 13 Oct 2011 10:18:13 -0000 Received: (qmail 26611 invoked by uid 22791); 13 Oct 2011 10:18:10 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL,BAYES_00 X-Spam-Check-By: sourceware.org Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Thu, 13 Oct 2011 10:17:50 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id C31422BB4AB; Thu, 13 Oct 2011 06:17:49 -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 FZ+p4sb197NE; Thu, 13 Oct 2011 06:17:49 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id B03162BB4A7; Thu, 13 Oct 2011 06:17:49 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id AF7B392BF6; Thu, 13 Oct 2011 06:17:49 -0400 (EDT) Date: Thu, 13 Oct 2011 06:17:49 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Fix runtime assertion failure in timed selective wait Message-ID: <20111013101749.GA17297@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) 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 This change ensures fixes an improper usage of Defer_Abort where Defer_Abort_Nestable is meant, that would cause a failed assrtion if a timed selective accept statement occurs when there already is a pending call to the accepted entry. The following program must compile and execute quietly: with Ada.Exceptions; with Ada.Text_IO; use Ada.Text_IO; procedure Call_Then_Accept is task Caller is entry Start; end Caller; task Callee is entry Start; entry With_Body; end Callee; task body Caller is begin accept Start do null; end Start; Callee.With_Body; end Caller; task body Callee is Called : Boolean := False; begin accept Start do null; end Start; select delay 10.0; or accept With_Body do Called := True; end With_Body; end select; exception when E : others => Put_Line ("Callee: got " & Ada.Exceptions.Exception_Information (E)); end Callee; begin Caller.Start; delay 0.1; Callee.Start; end Call_Then_Accept; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-10-13 Thomas Quinot * s-tasren.adb (Timed_Selective_Wait, case Accept_Alternative_Selected): Use Defer_Abort_Nestable, since we know abortion is already deferred. Index: s-tasren.adb =================================================================== --- s-tasren.adb (revision 179894) +++ s-tasren.adb (working copy) @@ -1502,7 +1502,7 @@ -- Null_Body. Defer abort until it gets into the accept body. Uninterpreted_Data := Self_Id.Common.Call.Uninterpreted_Data; - Initialization.Defer_Abort (Self_Id); + Initialization.Defer_Abort_Nestable (Self_Id); STPO.Unlock (Self_Id); when Accept_Alternative_Completed =>