From patchwork Wed Nov 18 10:06:03 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 545936 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.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 45075141448 for ; Wed, 18 Nov 2015 21:06:14 +1100 (AEDT) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=fMfI3xrX; dkim-atps=neutral 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=AUzAbPOdTr2xxi8NnyVoee3KnYGx0B1+dfh2961LKin381sKnG proj0BUKg1Ka59pGKyenCOd8+IBk87dai5j5+l6xdZHmR245KEIRYtcr0KCzdoEJ 7QQrISAiBq3LsiKYmDG2Juve4qojxdbIcrb1cWLfK+8/bMkfEMc/pevJE= 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=HWWmSLWSUymbNLVl/6ENJyVQUnA=; b=fMfI3xrXfGlJxSmk1G1z lbygJDahwCUeqzlDnJYZmMTgt8wg17n3gjjBxgi4S/yDDcUWfiunJiepFrjNI4P0 Tft6tIJ+3lFXtzKZSoQJw5jQNIYaIRaM2pqFQnK/+VHyvq9SlhNA7Ckg6fDZpzNR PepmJmUXW+Kupu2rn8ZSjvY= Received: (qmail 25092 invoked by alias); 18 Nov 2015 10:06:07 -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 25077 invoked by uid 89); 18 Nov 2015 10:06:06 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=1.1 required=5.0 tests=BAYES_40, KAM_ASCII_DIVIDERS, KAM_LAZY_DOMAIN_SECURITY, RCVD_IN_DNSWL_LOW autolearn=no version=3.3.2 X-HELO: rock.gnat.com 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; Wed, 18 Nov 2015 10:06:05 +0000 Received: from localhost (localhost.localdomain [127.0.0.1]) by filtered-rock.gnat.com (Postfix) with ESMTP id 3B2BB2952A; Wed, 18 Nov 2015 05:06:03 -0500 (EST) 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 ZeB2HpS2aqxc; Wed, 18 Nov 2015 05:06:03 -0500 (EST) Received: from tron.gnat.com (tron.gnat.com [IPv6:2620:20:4000:0:46a8:42ff:fe0e:e294]) by rock.gnat.com (Postfix) with ESMTP id 291D329529; Wed, 18 Nov 2015 05:06:03 -0500 (EST) Received: by tron.gnat.com (Postfix, from userid 4192) id 25C6736E; Wed, 18 Nov 2015 05:06:03 -0500 (EST) Date: Wed, 18 Nov 2015 05:06:03 -0500 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Hristian Kirtchev Subject: [Ada] Undefined symbols with pragma Initialize_Scalars Message-ID: <20151118100603.GA16748@adacore.com> MIME-Version: 1.0 Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) This patch modifies the generation of a constrained array subtype for an object declaration to use an external name. This ensures that a reference to the array subtype bounds are consistent when compiling with various switches and pragmas such as Initialize_Scalars. No simple reproducer possible. Tested on x86_64-pc-linux-gnu, committed on trunk 2015-11-18 Hristian Kirtchev * exp_util.adb (Expand_Subtype_From_Expr): Add new formal parameter Related_Id and propagate it to Make_Subtype_From_Expr. (Make_Subtype_From_Expr): Add new formal parameter Related_Id. Create external entities when requested by the caller. * exp_util.ads (Expand_Subtype_From_Expr): Add new formal parameter Related_Id. Update the comment on usage. (Make_Subtype_From_Expr): Add new formal parameter Related_Id. Update the comment on usage. * sem_ch3.adb (Analyze_Object_Declaration): Add local variable Related_Id. Generate an external constrained subtype when the object is a public symbol. Index: sem_ch3.adb =================================================================== --- sem_ch3.adb (revision 230522) +++ sem_ch3.adb (working copy) @@ -3390,6 +3390,7 @@ -- Local variables Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Related_Id : Entity_Id; -- Start of processing for Analyze_Object_Declaration @@ -4015,7 +4016,25 @@ return; else - Expand_Subtype_From_Expr (N, T, Object_Definition (N), E); + -- Ensure that the generated subtype has a unique external name + -- when the related object is public. This guarantees that the + -- subtype and its bounds will not be affected by switches or + -- pragmas that may offset the internal counter due to extra + -- generated code. + + if Is_Public (Id) then + Related_Id := Id; + else + Related_Id := Empty; + end if; + + Expand_Subtype_From_Expr + (N => N, + Unc_Type => T, + Subtype_Indic => Object_Definition (N), + Exp => E, + Related_Id => Related_Id); + Act_T := Find_Type_Of_Object (Object_Definition (N), N); end if; Index: exp_util.adb =================================================================== --- exp_util.adb (revision 230522) +++ exp_util.adb (working copy) @@ -2152,7 +2152,8 @@ (N : Node_Id; Unc_Type : Entity_Id; Subtype_Indic : Node_Id; - Exp : Node_Id) + Exp : Node_Id; + Related_Id : Entity_Id := Empty) is Loc : constant Source_Ptr := Sloc (N); Exp_Typ : constant Entity_Id := Etype (Exp); @@ -2357,7 +2358,7 @@ else Remove_Side_Effects (Exp); Rewrite (Subtype_Indic, - Make_Subtype_From_Expr (Exp, Unc_Type)); + Make_Subtype_From_Expr (Exp, Unc_Type, Related_Id)); end if; end Expand_Subtype_From_Expr; @@ -6566,8 +6567,9 @@ -- 3. If Expr is class-wide, creates an implicit class-wide subtype function Make_Subtype_From_Expr - (E : Node_Id; - Unc_Typ : Entity_Id) return Node_Id + (E : Node_Id; + Unc_Typ : Entity_Id; + Related_Id : Entity_Id := Empty) return Node_Id is List_Constr : constant List_Id := New_List; Loc : constant Source_Ptr := Sloc (E); @@ -6584,18 +6586,32 @@ if Is_Private_Type (Unc_Typ) and then Has_Unknown_Discriminants (Unc_Typ) then + -- The caller requests a unque external name for both the private and + -- the full subtype. + + if Present (Related_Id) then + Full_Subtyp := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Related_Id), 'C')); + Priv_Subtyp := + Make_Defining_Identifier (Loc, + Chars => New_External_Name (Chars (Related_Id), 'P')); + + else + Full_Subtyp := Make_Temporary (Loc, 'C'); + Priv_Subtyp := Make_Temporary (Loc, 'P'); + end if; + -- Prepare the subtype completion. Use the base type to find the -- underlying type because the type may be a generic actual or an -- explicit subtype. - Utyp := Underlying_Type (Base_Type (Unc_Typ)); - Full_Subtyp := Make_Temporary (Loc, 'C'); - Full_Exp := + Utyp := Underlying_Type (Base_Type (Unc_Typ)); + + Full_Exp := Unchecked_Convert_To (Utyp, Duplicate_Subexpr_No_Checks (E)); Set_Parent (Full_Exp, Parent (E)); - Priv_Subtyp := Make_Temporary (Loc, 'P'); - Insert_Action (E, Make_Subtype_Declaration (Loc, Defining_Identifier => Full_Subtyp, Index: exp_util.ads =================================================================== --- exp_util.ads (revision 230522) +++ exp_util.ads (working copy) @@ -445,10 +445,12 @@ (N : Node_Id; Unc_Type : Entity_Id; Subtype_Indic : Node_Id; - Exp : Node_Id); + Exp : Node_Id; + Related_Id : Entity_Id := Empty); -- Build a constrained subtype from the initial value in object -- declarations and/or allocations when the type is indefinite (including - -- class-wide). + -- class-wide). Set Related_Id to request an external name for the subtype + -- rather than an internal temporary. function Finalize_Address (Typ : Entity_Id) return Entity_Id; -- Locate TSS primitive Finalize_Address in type Typ. Return Empty if the @@ -780,11 +782,13 @@ -- Predicate_Check is suppressed then a null statement is returned instead. function Make_Subtype_From_Expr - (E : Node_Id; - Unc_Typ : Entity_Id) return Node_Id; + (E : Node_Id; + Unc_Typ : Entity_Id; + Related_Id : Entity_Id := Empty) return Node_Id; -- Returns a subtype indication corresponding to the actual type of an - -- expression E. Unc_Typ is an unconstrained array or record, or - -- a classwide type. + -- expression E. Unc_Typ is an unconstrained array or record, or a class- + -- wide type. Set Related_Id to request an external name for the subtype + -- rather than an internal temporary. function Matching_Standard_Type (Typ : Entity_Id) return Entity_Id; -- Given a scalar subtype Typ, returns a matching type in standard that