From patchwork Mon Jun 14 10:10:20 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 55508 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 79E5A1007D2 for ; Mon, 14 Jun 2010 20:10:23 +1000 (EST) Received: (qmail 23469 invoked by alias); 14 Jun 2010 10:10:20 -0000 Received: (qmail 23459 invoked by uid 22791); 14 Jun 2010 10:10:18 -0000 X-SWARE-Spam-Status: No, hits=-0.5 required=5.0 tests=AWL, BAYES_50, 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; Mon, 14 Jun 2010 10:10:12 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id AAAD2CB02BF; Mon, 14 Jun 2010 12:10:15 +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 B9l2+xZjlBaz; Mon, 14 Jun 2010 12:10:15 +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 90C78CB02BD; Mon, 14 Jun 2010 12:10:15 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id 028B8D9B31; Mon, 14 Jun 2010 12:10:20 +0200 (CEST) Date: Mon, 14 Jun 2010 12:10:20 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Initialize_Scalars should not clobber variable with address clause Message-ID: <20100614101020.GA5611@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 patch prevents Initialize_Scalars from initializing scalars with address clauses, and thus suppresses the annoying warning associated with this initialization. The following should compile quietly (it used to give a warning about needing pragma Import). pragma Initialize_Scalars; with System; use System; procedure IS_Overlay (A : Address) is X : Integer; for X'Address use A; begin null; end; Tested on x86_64-pc-linux-gnu, committed on trunk 2010-06-14 Robert Dewar * exp_aggr.adb (Has_Address_Clause): Moved to Exp_Util, and there it is renamed as Has_Following_Address_Clause. * exp_ch3.adb (Needs_Simple_Initialization): Add Consider_IS argument to allow the caller to avoid Initialize_Scalars having an effect. (Expand_N_Object_Declaration): Do not do Initialize_Scalars stuff for scalars with an address clause specified. * exp_ch3.ads (Needs_Simple_Initialization): Add Consider_IS argument to allow the caller to avoid Initialize_Scalars having an effect. * exp_util.adb (Has_Following_Address_Clause): Moved here from Exp_Aggr (where it was called Has_Address_Clause). * exp_util.ads (Has_Following_Address_Clause): Moved here from Exp_Aggr (where it was called Has_Address_Clause). * freeze.adb (Warn_Overlay): Suppress message about overlaying causing problems for Initialize_Scalars (since we no longer initialize objects with an address clause. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 160705) +++ exp_util.adb (working copy) @@ -2143,6 +2143,37 @@ return False; end Has_Controlled_Coextensions; + ------------------------ + -- Has_Address_Clause -- + ------------------------ + + -- Should this function check the private part in a package ??? + + function Has_Following_Address_Clause (D : Node_Id) return Boolean is + Id : constant Entity_Id := Defining_Identifier (D); + Decl : Node_Id; + + begin + Decl := Next (D); + while Present (Decl) loop + if Nkind (Decl) = N_At_Clause + and then Chars (Identifier (Decl)) = Chars (Id) + then + return True; + + elsif Nkind (Decl) = N_Attribute_Definition_Clause + and then Chars (Decl) = Name_Address + and then Chars (Name (Decl)) = Chars (Id) + then + return True; + end if; + + Next (Decl); + end loop; + + return False; + end Has_Following_Address_Clause; + -------------------- -- Homonym_Number -- -------------------- Index: exp_util.ads =================================================================== --- exp_util.ads (revision 160705) +++ exp_util.ads (working copy) @@ -444,6 +444,11 @@ -- Determine whether a record type has anonymous access discriminants with -- a controlled designated type. + function Has_Following_Address_Clause (D : Node_Id) return Boolean; + -- D is the node for an object declaration. This function searches the + -- current declarative part to look for an address clause for the object + -- being declared, and returns True if one is found. + function Homonym_Number (Subp : Entity_Id) return Nat; -- Here subp is the entity for a subprogram. This routine returns the -- homonym number used to disambiguate overloaded subprograms in the same Index: freeze.adb =================================================================== --- freeze.adb (revision 160705) +++ freeze.adb (working copy) @@ -5659,16 +5659,18 @@ -- We only give the warning for non-imported entities of a type for -- which a non-null base init proc is defined, or for objects of access - -- types with implicit null initialization, or when Initialize_Scalars + -- types with implicit null initialization, or when Normalize_Scalars -- applies and the type is scalar or a string type (the latter being -- tested for because predefined String types are initialized by inline - -- code rather than by an init_proc). + -- code rather than by an init_proc). Note that we do not give the + -- warning for Initialize_Scalars, since we suppressed initialization + -- in this case. if Present (Expr) and then not Is_Imported (Ent) and then (Has_Non_Null_Base_Init_Proc (Typ) or else Is_Access_Type (Typ) - or else (Init_Or_Norm_Scalars + or else (Normalize_Scalars and then (Is_Scalar_Type (Typ) or else Is_String_Type (Typ)))) then Index: exp_aggr.adb =================================================================== --- exp_aggr.adb (revision 160705) +++ exp_aggr.adb (working copy) @@ -4122,12 +4122,6 @@ -- array sub-aggregate we start the computation from. Dim is the -- dimension corresponding to the sub-aggregate. - function Has_Address_Clause (D : Node_Id) return Boolean; - -- If the aggregate is the expression in an object declaration, it - -- cannot be expanded in place. This function does a lookahead in the - -- current declarative part to find an address clause for the object - -- being declared. - function In_Place_Assign_OK return Boolean; -- Simple predicate to determine whether an aggregate assignment can -- be done in place, because none of the new values can depend on the @@ -4435,35 +4429,6 @@ end Compute_Others_Present; ------------------------ - -- Has_Address_Clause -- - ------------------------ - - function Has_Address_Clause (D : Node_Id) return Boolean is - Id : constant Entity_Id := Defining_Identifier (D); - Decl : Node_Id; - - begin - Decl := Next (D); - while Present (Decl) loop - if Nkind (Decl) = N_At_Clause - and then Chars (Identifier (Decl)) = Chars (Id) - then - return True; - - elsif Nkind (Decl) = N_Attribute_Definition_Clause - and then Chars (Decl) = Name_Address - and then Chars (Name (Decl)) = Chars (Id) - then - return True; - end if; - - Next (Decl); - end loop; - - return False; - end Has_Address_Clause; - - ------------------------ -- In_Place_Assign_OK -- ------------------------ @@ -5162,6 +5127,8 @@ Build_Activation_Chain_Entity (N); end if; + -- Should document these individual tests ??? + if not Has_Default_Init_Comps (N) and then Comes_From_Source (Parent (N)) and then Nkind (Parent (N)) = N_Object_Declaration @@ -5170,7 +5137,13 @@ and then N = Expression (Parent (N)) and then not Is_Bit_Packed_Array (Typ) and then not Has_Controlled_Component (Typ) - and then not Has_Address_Clause (Parent (N)) + + -- If the aggregate is the expression in an object declaration, it + -- cannot be expanded in place. Lookahead in the current declarative + -- part to find an address clause for the object being declared. If + -- one is present, we cannot build in place. Unclear comment??? + + and then not Has_Following_Address_Clause (Parent (N)) then Tmp := Defining_Identifier (Parent (N)); Set_No_Initialization (Parent (N)); Index: exp_ch3.adb =================================================================== --- exp_ch3.adb (revision 160716) +++ exp_ch3.adb (working copy) @@ -4466,7 +4466,10 @@ -- it will be assigned subsequently. In particular, there is no point -- in applying Initialize_Scalars to such a temporary. - elsif Needs_Simple_Initialization (Typ) + elsif Needs_Simple_Initialization + (Typ, + Initialize_Scalars + and then not Has_Following_Address_Clause (N)) and then not Is_Internal (Def_Id) and then not Has_Init_Expression (N) then @@ -8145,7 +8148,14 @@ -- Needs_Simple_Initialization -- --------------------------------- - function Needs_Simple_Initialization (T : Entity_Id) return Boolean is + function Needs_Simple_Initialization + (T : Entity_Id; + Consider_IS : Boolean := True) return Boolean + is + Consider_IS_NS : constant Boolean := + Normalize_Scalars + or (Initialize_Scalars and Consider_IS); + begin -- Check for private type, in which case test applies to the underlying -- type of the private type. @@ -8167,7 +8177,7 @@ -- types. elsif Is_Access_Type (T) - or else (Init_Or_Norm_Scalars and then (Is_Scalar_Type (T))) + or else (Consider_IS_NS and then (Is_Scalar_Type (T))) then return True; @@ -8176,7 +8186,7 @@ -- expanding an aggregate (since in the latter case they will be -- filled with appropriate initializing values before they are used). - elsif Init_Or_Norm_Scalars + elsif Consider_IS_NS and then (Root_Type (T) = Standard_String or else Root_Type (T) = Standard_Wide_String Index: exp_ch3.ads =================================================================== --- exp_ch3.ads (revision 160705) +++ exp_ch3.ads (working copy) @@ -126,14 +126,18 @@ -- then tags components located at variable positions of Target are -- initialized. - function Needs_Simple_Initialization (T : Entity_Id) return Boolean; + function Needs_Simple_Initialization + (T : Entity_Id; + Consider_IS : Boolean := True) return Boolean; -- Certain types need initialization even though there is no specific -- initialization routine. In this category are access types (which need -- initializing to null), packed array types whose implementation is a -- modular type, and all scalar types if Normalize_Scalars is set, as well -- as private types whose underlying type is present and meets any of these -- criteria. Finally, descendants of String and Wide_String also need - -- initialization in Initialize/Normalize_Scalars mode. + -- initialization in Initialize/Normalize_Scalars mode. Consider_IS is + -- normally True. If it is False, the Initialize_Scalars is not considered + -- in determining whether simple initialization is needed. function Get_Simple_Init_Val (T : Entity_Id;