From patchwork Thu Aug 5 09:27:02 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 60942 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 A9639B70A8 for ; Thu, 5 Aug 2010 19:27:25 +1000 (EST) Received: (qmail 31572 invoked by alias); 5 Aug 2010 09:27:13 -0000 Received: (qmail 31495 invoked by uid 22791); 5 Aug 2010 09:27:11 -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; Thu, 05 Aug 2010 09:27:05 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 88C70CB0242; Thu, 5 Aug 2010 11:27:02 +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 g-gD+al4MfYD; Thu, 5 Aug 2010 11:27:02 +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 70459CB0215; Thu, 5 Aug 2010 11:27:02 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 4E061D9BB4; Thu, 5 Aug 2010 11:27:02 +0200 (CEST) Date: Thu, 5 Aug 2010 11:27:02 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Ed Schonberg Subject: [Ada] Constant-folding and mutable discriminants Message-ID: <20100805092702.GA1458@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 If a selected component denotes the discriminant of a constrained object it is some times possible to replace the reference with the known discriminant value. This optimization is disabled if the discriminant is in any way mutable, for example the discriminant of a type with default discriminants, and when the reference is the name in a renaming declaration. With this patch the compiler also handles properly the case where the reference denotes the discriminant of a constrained component of a record, where the inner discriminant may be constrained by the outer one, and the outer one may be mutable. The following must execute quietly: --- procedure Mutable_Discrim is subtype Index is Integer range 0 .. 255; type T1 (Hi1 : Index) is record F1 : String (1 .. Hi1); end record; type T2 (Hi2 : Index := 0) is record F2 : T1 (Hi1 => Hi2); end record; X : T2 := (3, (3, "cat")); Hi1_Ren : Natural renames X.F2.Hi1; begin pragma Assert (Hi1_Ren = 3); X := (4, (4, "goat")); pragma Assert (Hi1_Ren = 4); end Mutable_Discrim; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-08-05 Ed Schonberg * exp_ch4.adb (Expand_N_Selected_Component): Do not constant-fold a selected component that denotes a discriminant if it is the discriminant of a component of an unconstrained record type. Index: exp_ch4.adb =================================================================== --- exp_ch4.adb (revision 162907) +++ exp_ch4.adb (working copy) @@ -7463,7 +7463,7 @@ package body Exp_Ch4 is null; -- Don't do this optimization for the prefix of an attribute or - -- the operand of an object renaming declaration since these are + -- the name of an object renaming declaration since these are -- contexts where we do not want the value anyway. elsif (Nkind (Par) = N_Attribute_Reference @@ -7472,6 +7472,18 @@ package body Exp_Ch4 is then null; + -- If this is a discriminant of a component of a mutable record, + -- or a renaming of such, no optimization is possible, and value + -- must be retrieved anew. Note that in the previous case we may + -- be dealing with a renaming declaration, while here we may have + -- a use of a renaming. + + elsif Nkind (P) = N_Selected_Component + and then Is_Record_Type (Etype (Prefix (P))) + and then not Is_Constrained (Etype (Prefix (P))) + then + null; + -- Don't do this optimization if we are within the code for a -- discriminant check, since the whole point of such a check may -- be to verify the condition on which the code below depends!