From patchwork Thu Oct 7 10:59:53 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Arnaud Charlet X-Patchwork-Id: 67031 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 B37EEB70A5 for ; Thu, 7 Oct 2010 22:00:06 +1100 (EST) Received: (qmail 18731 invoked by alias); 7 Oct 2010 11:00:04 -0000 Received: (qmail 18667 invoked by uid 22791); 7 Oct 2010 11:00:02 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, TW_TR, 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, 07 Oct 2010 10:59:56 +0000 Received: from localhost (localhost [127.0.0.1]) by filtered-smtp.eu.adacore.com (Postfix) with ESMTP id 12E2ECB022E; Thu, 7 Oct 2010 12:59:54 +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 vWHEmxfGwGJ7; Thu, 7 Oct 2010 12:59:54 +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 F381ECB0227; Thu, 7 Oct 2010 12:59:53 +0200 (CEST) Received: by saumur.act-europe.fr (Postfix, from userid 525) id D6ED3D9BB5; Thu, 7 Oct 2010 12:59:53 +0200 (CEST) Date: Thu, 7 Oct 2010 12:59:53 +0200 From: Arnaud Charlet To: gcc-patches@gcc.gnu.org Cc: Robert Dewar Subject: [Ada] Reorganize Full_Qualified_Name handling Message-ID: <20101007105953.GA27801@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 subprogram was in Sem_Util, but this patch moves it to Exp_Util where it belongs (it was only used in the expander) and renames it to Fully_Qualified_Name_String. No test is needed, this is just a cleanup, no functional change Tested on x86_64-pc-linux-gnu, committed on trunk 2010-10-07 Robert Dewar * exp_disp.adb, exp_dist.adb, exp_util.ads, exp_util.adb, exp_ch11.adb: Rename Full_Qualified_Name to Fully_Qualified_Name_String * sem_util.adb, sem_util.ads (Full_Qualified_Name): Moved to Exp_Util.Fully_Qualified_Name_String. Index: exp_util.adb =================================================================== --- exp_util.adb (revision 165084) +++ exp_util.adb (working copy) @@ -24,6 +24,7 @@ ------------------------------------------------------------------------------ with Atree; use Atree; +with Casing; use Casing; with Checks; use Checks; with Debug; use Debug; with Einfo; use Einfo; @@ -1753,6 +1754,62 @@ package body Exp_Util is Remove_Side_Effects (Exp, Name_Req, Variable_Ref => True); end Force_Evaluation; + --------------------------------- + -- Fully_Qualified_Name_String -- + --------------------------------- + + function Fully_Qualified_Name_String (E : Entity_Id) return String_Id is + procedure Internal_Full_Qualified_Name (E : Entity_Id); + -- Compute recursively the qualified name without NUL at the end, adding + -- it to the currently started string being generated + + ---------------------------------- + -- Internal_Full_Qualified_Name -- + ---------------------------------- + + procedure Internal_Full_Qualified_Name (E : Entity_Id) is + Ent : Entity_Id; + + begin + -- Deal properly with child units + + if Nkind (E) = N_Defining_Program_Unit_Name then + Ent := Defining_Identifier (E); + else + Ent := E; + end if; + + -- Compute qualification recursively (only "Standard" has no scope) + + if Present (Scope (Scope (Ent))) then + Internal_Full_Qualified_Name (Scope (Ent)); + Store_String_Char (Get_Char_Code ('.')); + end if; + + -- Every entity should have a name except some expanded blocks + -- don't bother about those. + + if Chars (Ent) = No_Name then + return; + end if; + + -- Generates the entity name in upper case + + Get_Decoded_Name_String (Chars (Ent)); + Set_All_Upper_Case; + Store_String_Chars (Name_Buffer (1 .. Name_Len)); + return; + end Internal_Full_Qualified_Name; + + -- Start of processing for Full_Qualified_Name + + begin + Start_String; + Internal_Full_Qualified_Name (E); + Store_String_Char (Get_Char_Code (ASCII.NUL)); + return End_String; + end Fully_Qualified_Name_String; + ------------------------ -- Generate_Poll_Call -- ------------------------ Index: exp_util.ads =================================================================== --- exp_util.ads (revision 165080) +++ exp_util.ads (working copy) @@ -403,6 +403,10 @@ package Exp_Util is -- Force_Evaluation further guarantees that all evaluations will yield -- the same result. + function Fully_Qualified_Name_String (E : Entity_Id) return String_Id; + -- Generates the string literal corresponding to the fully qualified name + -- of entity E with an ASCII.NUL appended at the end of the name. + procedure Generate_Poll_Call (N : Node_Id); -- If polling is active, then a call to the Poll routine is built, -- and then inserted before the given node N and analyzed. Index: sem_util.adb =================================================================== --- sem_util.adb (revision 165080) +++ sem_util.adb (working copy) @@ -3468,71 +3468,6 @@ package body Sem_Util is end if; end First_Actual; - ------------------------- - -- Full_Qualified_Name -- - ------------------------- - - function Full_Qualified_Name (E : Entity_Id) return String_Id is - Res : String_Id; - pragma Warnings (Off, Res); - - function Internal_Full_Qualified_Name (E : Entity_Id) return String_Id; - -- Compute recursively the qualified name without NUL at the end - - ---------------------------------- - -- Internal_Full_Qualified_Name -- - ---------------------------------- - - function Internal_Full_Qualified_Name (E : Entity_Id) return String_Id is - Ent : Entity_Id := E; - Parent_Name : String_Id := No_String; - - begin - -- Deals properly with child units - - if Nkind (Ent) = N_Defining_Program_Unit_Name then - Ent := Defining_Identifier (Ent); - end if; - - -- Compute qualification recursively (only "Standard" has no scope) - - if Present (Scope (Scope (Ent))) then - Parent_Name := Internal_Full_Qualified_Name (Scope (Ent)); - end if; - - -- Every entity should have a name except some expanded blocks - -- don't bother about those. - - if Chars (Ent) = No_Name then - return Parent_Name; - end if; - - -- Add a period between Name and qualification - - if Parent_Name /= No_String then - Start_String (Parent_Name); - Store_String_Char (Get_Char_Code ('.')); - - else - Start_String; - end if; - - -- Generates the entity name in upper case - - Get_Decoded_Name_String (Chars (Ent)); - Set_All_Upper_Case; - Store_String_Chars (Name_Buffer (1 .. Name_Len)); - return End_String; - end Internal_Full_Qualified_Name; - - -- Start of processing for Full_Qualified_Name - - begin - Res := Internal_Full_Qualified_Name (E); - Store_String_Char (Get_Char_Code (ASCII.NUL)); - return End_String; - end Full_Qualified_Name; - ----------------------- -- Gather_Components -- ----------------------- Index: sem_util.ads =================================================================== --- sem_util.ads (revision 165080) +++ sem_util.ads (working copy) @@ -379,11 +379,6 @@ package Sem_Util is -- is always the expression (not the N_Parameter_Association nodes, -- even if named association is used). - function Full_Qualified_Name (E : Entity_Id) return String_Id; - -- Generates the string literal corresponding to the E's full qualified - -- name in upper case. An ASCII.NUL is appended as the last character. - -- The names in the string are generated by Namet.Get_Decoded_Name_String. - procedure Gather_Components (Typ : Entity_Id; Comp_List : Node_Id; Index: exp_ch11.adb =================================================================== --- exp_ch11.adb (revision 165088) +++ exp_ch11.adb (working copy) @@ -1265,7 +1265,7 @@ package body Exp_Ch11 is Object_Definition => New_Occurrence_Of (Standard_String, Loc), Expression => Make_String_Literal (Loc, - Strval => Full_Qualified_Name (Id)))); + Strval => Fully_Qualified_Name_String (Id)))); Set_Is_Statically_Allocated (Exname); Index: exp_disp.adb =================================================================== --- exp_disp.adb (revision 165081) +++ exp_disp.adb (working copy) @@ -4483,8 +4483,7 @@ package body Exp_Disp is end loop; end if; - -- Get the _tag entity and the number of primitives of its dispatch - -- table. + -- Get the _tag entity and number of primitives of its dispatch table DT_Ptr := Node (First_Elmt (Access_Disp_Table (Typ))); Nb_Prim := UI_To_Int (DT_Entry_Count (First_Tag_Component (Typ))); @@ -4654,7 +4653,7 @@ package body Exp_Disp is Object_Definition => New_Reference_To (Standard_String, Loc), Expression => Make_String_Literal (Loc, - Full_Qualified_Name (First_Subtype (Typ))))); + Fully_Qualified_Name_String (First_Subtype (Typ))))); Set_Is_Statically_Allocated (Exname); Set_Is_True_Constant (Exname); @@ -4768,7 +4767,7 @@ package body Exp_Disp is New_External_Name (Tname, 'A')); Full_Name : constant String_Id := - Full_Qualified_Name (First_Subtype (Typ)); + Fully_Qualified_Name_String (First_Subtype (Typ)); Str1_Id : String_Id; Str2_Id : String_Id; Index: exp_dist.adb =================================================================== --- exp_dist.adb (revision 165080) +++ exp_dist.adb (working copy) @@ -5541,7 +5541,7 @@ package body Exp_Dist is -- Name Make_String_Literal (Loc, - Full_Qualified_Name (Desig)), + Fully_Qualified_Name_String (Desig)), -- Handler @@ -5887,7 +5887,7 @@ package body Exp_Dist is Unchecked_Convert_To (RTE (RE_Address), New_Occurrence_Of (RACW_Parameter, Loc)), Make_String_Literal (Loc, - Strval => Full_Qualified_Name + Strval => Fully_Qualified_Name_String (Etype (Designated_Type (RACW_Type)))), Build_Stub_Tag (Loc, RACW_Type), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc), @@ -6083,7 +6083,7 @@ package body Exp_Dist is Parameter_Associations => New_List ( Unchecked_Convert_To (RTE (RE_Address), Object), Make_String_Literal (Loc, - Strval => Full_Qualified_Name + Strval => Fully_Qualified_Name_String (Etype (Designated_Type (RACW_Type)))), Build_Stub_Tag (Loc, RACW_Type), New_Occurrence_Of (Boolean_Literals (Is_RAS), Loc),