From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: 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-Archive: List-Post: List-Help: Sender: gcc-patches-owner@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 10:06:00 -0000 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-Type: multipart/mixed; boundary="rwEMma7ioTxnRzrJ" Content-Disposition: inline User-Agent: Mutt/1.5.23 (2014-03-12) X-SW-Source: 2015-11/txt/msg02182.txt.bz2 --rwEMma7ioTxnRzrJ Content-Type: text/plain; charset=us-ascii Content-Disposition: inline Content-length: 1011 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. --rwEMma7ioTxnRzrJ Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename=difs Content-length: 5687 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 --rwEMma7ioTxnRzrJ--