From patchwork Tue Sep 10 14:50:17 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 273889 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 did not present a certificate) by ozlabs.org (Postfix) with ESMTPS id DFF242C027A for ; Wed, 11 Sep 2013 00:50:26 +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=hRQgj+sc03UDQeAMLay0qjLiGQU0Qp9uD4EKlfFv32bJ50og5d 28/8ClxC5RjUQ5xfVbffawwf+zBxtw/5MMwwsMmFrsvkKm7dhbKdAaBXdT4w2Rid uScY3f6jdkfbmklbAgSHYVwCUE4F0TWFyV2UFybaU2APtyuSKUbjMdsug= 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=TNXXbmHLk6z0kR50P5q3sNY8Akg=; b=L0FQ33Iy9Gdgt2+xM75A eNbQ20o090CjUOiiLOeFOGXeyxWHBp9DYrOD04H3wwWKqOCBmGnNfouxm3YfAGMK 0YV9a6C5FP9zviMrZSII+5CjpR6Y5FDpefj3SU8NrylJOteLaGHnPEWmjgNYIPWo 8hk/Qtuh3TDUuFI2vvC3xRk= Received: (qmail 15913 invoked by alias); 10 Sep 2013 14:50:20 -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 15898 invoked by uid 89); 10 Sep 2013 14:50:19 -0000 Received: from rock.gnat.com (HELO rock.gnat.com) (205.232.38.15) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Tue, 10 Sep 2013 14:50:19 +0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.6 required=5.0 tests=BAYES_50, RDNS_NONE autolearn=no version=3.3.2 X-HELO: rock.gnat.com Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 57BDD1164CC; Tue, 10 Sep 2013 10:50:29 -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 7roMCzCKKAa1; Tue, 10 Sep 2013 10:50:29 -0400 (EDT) Received: from kwai.gnat.com (unknown [IPv6:2620:20:4000:0:a6ba:dbff:fe26:1f63]) by rock.gnat.com (Postfix) with ESMTP id 4870611635F; Tue, 10 Sep 2013 10:50:29 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 83B053FB31; Tue, 10 Sep 2013 10:50:17 -0400 (EDT) Date: Tue, 10 Sep 2013 10:50:17 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Infinite loop while analysing aspect Global Message-ID: <20130910145017.GA4407@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.20 (2009-06-14) This patch corrects the check of a Global item of mode In_Out or Out that appear as an input in the Global aspect of an enclosing subprogram. Prior to this patch, the check caused an infinite loop in certain scenarios. ------------ -- Source -- ------------ -- stack_overflow.adb procedure Stack_Overflow is X : Integer; procedure Error with Global => (Input => X) is procedure OK_1 with Global => (In_Out => X) is procedure OK_2 (Par1 : out Integer) with Global => (In_Out => X) is begin X := X + 1; Par1 := X; end OK_2; begin null; end OK_1; begin null; end Error; begin null; end Stack_Overflow; ----------------- -- Compilation -- ----------------- $ gcc -c -gnat12 -gnatd.V stack_overflow.adb stack_overflow.adb:8:36: global item "X" cannot have mode In_Out or Output stack_overflow.adb:8:36: item already appears as input of subprogram "Error" Tested on x86_64-pc-linux-gnu, committed on trunk 2013-09-10 Hristian Kirtchev * sem_prag.adb (Check_Mode_Restriction_In_Enclosing_Context): Add local variable Context. Remove local variable Subp_Id. Start the context traversal from the current subprogram rather than the current scope. Update the scope traversal and error reporting. Index: sem_prag.adb =================================================================== --- sem_prag.adb (revision 202453) +++ sem_prag.adb (working copy) @@ -1514,22 +1514,24 @@ (Item : Node_Id; Item_Id : Entity_Id) is + Context : Entity_Id; Dummy : Boolean; Inputs : Elist_Id := No_Elist; Outputs : Elist_Id := No_Elist; - Subp_Id : Entity_Id; begin -- Traverse the scope stack looking for enclosing subprograms -- subject to aspect/pragma Global. - Subp_Id := Scope (Current_Scope); - while Present (Subp_Id) and then Subp_Id /= Standard_Standard loop - if Is_Subprogram (Subp_Id) - and then Has_Aspect (Subp_Id, Aspect_Global) + Context := Scope (Subp_Id); + while Present (Context) + and then Context /= Standard_Standard + loop + if Is_Subprogram (Context) + and then Has_Aspect (Context, Aspect_Global) then Collect_Subprogram_Inputs_Outputs - (Subp_Id => Subp_Id, + (Subp_Id => Context, Subp_Inputs => Inputs, Subp_Outputs => Outputs, Global_Seen => Dummy); @@ -1545,11 +1547,15 @@ Item, Item_Id); Error_Msg_NE ("\item already appears as input of subprogram &", - Item, Subp_Id); + Item, Context); + + -- Stop the traversal once an error has been detected + + exit; end if; end if; - Subp_Id := Scope (Subp_Id); + Context := Scope (Context); end loop; end Check_Mode_Restriction_In_Enclosing_Context;