From patchwork Thu Jun 14 10:56:41 2012 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 164913 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 1268FB705D for ; Thu, 14 Jun 2012 20:57:02 +1000 (EST) Comment: DKIM? See http://www.dkim.org DKIM-Signature: v=1; a=rsa-sha1; c=relaxed/relaxed; d=gcc.gnu.org; s=default; x=1340276223; h=Comment: DomainKey-Signature:Received:Received:Received:Received:Received: Received:Received:Date:From:To:Cc:Subject:Message-ID: MIME-Version:Content-Type:Content-Disposition:User-Agent: Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive: List-Post:List-Help:Sender:Delivered-To; bh=VLwAB7t7YHyLu8n1glds FA+bh5M=; b=BB+0FA4dvoK7XfM7z2aTs2K2UINWOCdbXKpADPKAko+gORuWNp+j NpXc/WF5Rq/ExYGnCx/ARL6nebc4NMRm/WKJ9cF0J98oVqy0IiyHdQz1PriP7vMD yTjWtzEvaikYIRy2bf4gH8umYFPL51HU+SOjVBCjR30Phv3gU6XGeOI= Comment: DomainKeys? See http://antispam.yahoo.com/domainkeys DomainKey-Signature: a=rsa-sha1; q=dns; c=nofws; s=default; d=gcc.gnu.org; h=Received:Received:X-SWARE-Spam-Status:X-Spam-Check-By:Received:Received:Received:Received:Received:Date:From:To:Cc:Subject:Message-ID:MIME-Version:Content-Type:Content-Disposition:User-Agent:Mailing-List:Precedence:List-Id:List-Unsubscribe:List-Archive:List-Post:List-Help:Sender:Delivered-To; b=Y0b/JSV4YZgpX/Q1QEf8/h2Tiz1w4ZZZtUbhSClgPahftZLk+lZ04ZE9AW4Ixh 5z9+pdyjZncgADNpUEFZLBYJiginMEHBeUq1PeEC776tJYVq928tynklmAmIepJm df3xavn6YwabhGsr6Unzd95XkUE7l6stLXL232zGN9udI=; Received: (qmail 31954 invoked by alias); 14 Jun 2012 10:56:57 -0000 Received: (qmail 31943 invoked by uid 22791); 14 Jun 2012 10:56:55 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_HOSTKARMA_NO 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, 14 Jun 2012 10:56:42 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 6F7651C72B5; Thu, 14 Jun 2012 06:56:41 -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 oArysfAYarYf; Thu, 14 Jun 2012 06:56:41 -0400 (EDT) Received: from kwai.gnat.com (kwai.gnat.com [205.232.38.4]) by rock.gnat.com (Postfix) with ESMTP id 485751C72B4; Thu, 14 Jun 2012 06:56:41 -0400 (EDT) Received: by kwai.gnat.com (Postfix, from userid 4192) id 479FF92BF6; Thu, 14 Jun 2012 06:56:41 -0400 (EDT) Date: Thu, 14 Jun 2012 06:56:41 -0400 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Vincent Pucci Subject: [Ada] Freezing nodes placement fixed with quantified expression inside an expression function. Message-ID: <20120614105641.GA24092@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 patch implements the correct freezing actions in the context of a quantified expression inside an expression function. Tested on x86_64-pc-linux-gnu, committed on trunk 2012-06-14 Vincent Pucci * freeze.adb (In_Exp_Body): Expression function case added. (Freeze_Expression): Insert the Freeze_Nodes list before the correct current scope in case of a quantified expression. Index: freeze.adb =================================================================== --- freeze.adb (revision 188609) +++ freeze.adb (working copy) @@ -4698,13 +4698,15 @@ Id := Defining_Unit_Name (Specification (P)); if Nkind (Id) = N_Defining_Identifier - and then (Is_Init_Proc (Id) or else - Is_TSS (Id, TSS_Stream_Input) or else - Is_TSS (Id, TSS_Stream_Output) or else - Is_TSS (Id, TSS_Stream_Read) or else - Is_TSS (Id, TSS_Stream_Write) or else + and then (Is_Init_Proc (Id) or else + Is_TSS (Id, TSS_Stream_Input) or else + Is_TSS (Id, TSS_Stream_Output) or else + Is_TSS (Id, TSS_Stream_Read) or else + Is_TSS (Id, TSS_Stream_Write) or else Nkind (Original_Node (P)) = - N_Subprogram_Renaming_Declaration) + N_Subprogram_Renaming_Declaration or else + Nkind (Original_Node (P)) = + N_Expression_Function) then return True; else @@ -5091,9 +5093,9 @@ or else Ekind (Current_Scope) = E_Void then declare - N : constant Node_Id := Current_Scope; - Freeze_Nodes : List_Id := No_List; - Pos : Int := Scope_Stack.Last; + N : constant Node_Id := Current_Scope; + Freeze_Nodes : List_Id := No_List; + Pos : Int := Scope_Stack.Last; begin if Present (Desig_Typ) then @@ -5109,13 +5111,18 @@ end if; -- The current scope may be that of a constrained component of - -- an enclosing record declaration, which is above the current - -- scope in the scope stack. + -- an enclosing record declaration, or of a loop of an enclosing + -- quantified expression, which is above the current scope in the + -- scope stack. Indeed in the context of a quantified expression, + -- a scope is created and pushed above the current scope in order + -- to emulate the loop-like behavior of the quantified expression. -- If the expression is within a top-level pragma, as for a pre- -- condition on a library-level subprogram, nothing to do. if not Is_Compilation_Unit (Current_Scope) - and then Is_Record_Type (Scope (Current_Scope)) + and then (Is_Record_Type (Scope (Current_Scope)) + or else Nkind (Parent (Current_Scope)) = + N_Quantified_Expression) then Pos := Pos - 1; end if;