From patchwork Tue Jun 22 15:37:40 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 56524 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 04CD7B6F1A for ; Wed, 23 Jun 2010 01:37:45 +1000 (EST) Received: (qmail 12803 invoked by alias); 22 Jun 2010 15:37:44 -0000 Received: (qmail 12795 invoked by uid 22791); 22 Jun 2010 15:37:43 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from mel.act-europe.fr (HELO mel.act-europe.fr) (212.99.106.210) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Tue, 22 Jun 2010 15:37:38 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 8E962CB026C; Tue, 22 Jun 2010 17:37:40 +0200 (CEST) Received: from mel.act-europe.fr ([127.0.0.1]) by localhost (smtp.eu.adacore.com [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id jsTPZKI5DHR2; Tue, 22 Jun 2010 17:37:40 +0200 (CEST) Received: from saumur.act-europe.fr (saumur.act-europe.fr [10.10.0.183]) by mel.act-europe.fr (Postfix) with ESMTP id 7C1DACB023D; Tue, 22 Jun 2010 17:37:40 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 73FADD9BB4; Tue, 22 Jun 2010 17:37:40 +0200 (CEST) Date: Tue, 22 Jun 2010 17:37:40 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Thomas Quinot Subject: [Ada] Discriminant references in aggregates Message-ID: <20100622153740.GA4048@adacore.com> Mime-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.9i X-IsSubscribed: yes 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 fixes two unrelated issues in the handling of references to discriminants appearing in aggregates. If such a reference comes from a default expression, it denotes a discriminal of the type of the aggregate, and must be rewritten into a selected component prefixed by the entity for the aggregate object. But if the reference is to a discriminal of some other type (case of the aggregate being in a protected body), it must be left untouched at this point. When the rewriting does occur, it must use the Lhs parameter of Build_Record_Aggregate_Code, not Obj, which is present only in the variable declaration and dynamic allocation cases. The following compilation must be accepted quietly: $ gcc -c prot_discriminal_in_aggr.adb with GNAT.Sockets; package Prot_Discriminal_In_Aggr is protected type Prot (Port_Num : GNAT.Sockets.Port_Type) is private The_Data : GNAT.Sockets.Sock_Addr_Type := (GNAT.Sockets.Family_Inet, GNAT.Sockets.No_Inet_Addr, Port_Num); end Prot; end Prot_Discriminal_In_Aggr; package body Prot_Discriminal_In_Aggr is protected body Prot is end Prot; end Prot_Discriminal_In_Aggr; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-22 Thomas Quinot * exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an expression referring to a discriminal of the type of the aggregate (not a discriminal of some other unrelated type), and the prefix in the generated selected component must come from Lhs, not Obj. Index: exp_aggr.adb =================================================================== --- exp_aggr.adb (revision 161194) +++ exp_aggr.adb (working copy) @@ -93,7 +93,7 @@ package body Exp_Aggr is function Has_Default_Init_Comps (N : Node_Id) return Boolean; -- N is an aggregate (record or array). Checks the presence of default - -- initialization (<>) in any component (Ada 2005: AI-287) + -- initialization (<>) in any component (Ada 2005: AI-287). function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean; -- Returns true if N is an aggregate used to initialize the components @@ -2431,10 +2431,12 @@ package body Exp_Aggr is and then Present (Entity (Expr)) and then Ekind (Entity (Expr)) = E_In_Parameter and then Present (Discriminal_Link (Entity (Expr))) + and then Scope (Discriminal_Link (Entity (Expr))) + = Base_Type (Etype (N)) then Rewrite (Expr, Make_Selected_Component (Loc, - Prefix => New_Occurrence_Of (Obj, Loc), + Prefix => New_Copy_Tree (Lhs), Selector_Name => Make_Identifier (Loc, Chars (Expr)))); end if; return OK;